--------------------------------------------------
-- Export file for user FREEDOM                 --
-- Created by Relaximus on 28.01.2014, 23:10:26 --
--------------------------------------------------

set define off
spool install.log

prompt
prompt Creating table JSON_TESTSUITE
prompt =============================
prompt
create table FREEDOM.JSON_TESTSUITE
(
  collection VARCHAR2(20),
  passed     NUMBER,
  failed     NUMBER,
  total      NUMBER,
  filename   VARCHAR2(20)
)
tablespace USERS
  pctfree 10
  initrans 1
  maxtrans 255
  storage
  (
    initial 64K
    next 1M
    minextents 1
    maxextents unlimited
  );

prompt
prompt Creating table MY_RUNNING_JOBS
prompt ==============================
prompt
create global temporary table FREEDOM.MY_RUNNING_JOBS
(
  job_name VARCHAR2(32) not null
)
on commit preserve rows;

prompt
prompt Creating table T_CURRENCIES
prompt ===========================
prompt
create table FREEDOM.T_CURRENCIES
(
  code VARCHAR2(10) not null,
  name VARCHAR2(30)
)
tablespace USERS
  pctfree 10
  initrans 1
  maxtrans 255
  storage
  (
    initial 64K
    next 1M
    minextents 1
    maxextents unlimited
  );
alter table FREEDOM.T_CURRENCIES
  add constraint CUR_PK primary key (CODE)
  using index 
  tablespace USERS
  pctfree 10
  initrans 2
  maxtrans 255
  storage
  (
    initial 64K
    next 1M
    minextents 1
    maxextents unlimited
  );

prompt
prompt Creating table T_DEALS_END_STATE
prompt ================================
prompt
create table FREEDOM.T_DEALS_END_STATE
(
  id          NUMBER,
  id_load     NUMBER,
  buy_id      NUMBER not null,
  sell_id     NUMBER not null,
  dealk       NUMBER,
  deal_type   NUMBER,
  buy_rate    NUMBER not null,
  sell_rate   NUMBER not null,
  buy_market  NUMBER not null,
  sell_market NUMBER not null,
  cur_from    VARCHAR2(10) not null,
  cur_to      VARCHAR2(10) not null,
  buy_amount  NUMBER not null,
  sell_amount NUMBER not null,
  state       VARCHAR2(20),
  dt          DATE default SYSDATE not null,
  amount      NUMBER,
  profit      NUMBER
)
tablespace USERS
  pctfree 10
  initrans 1
  maxtrans 255
  storage
  (
    initial 64K
    next 1M
    minextents 1
    maxextents unlimited
  );

prompt
prompt Creating table T_MARKET
prompt =======================
prompt
create table FREEDOM.T_MARKET
(
  id      NUMBER not null,
  name    VARCHAR2(30) not null,
  fee     NUMBER,
  enabled VARCHAR2(2),
  changed DATE
)
tablespace USERS
  pctfree 10
  initrans 1
  maxtrans 255
  storage
  (
    initial 64K
    next 1M
    minextents 1
    maxextents unlimited
  );
alter table FREEDOM.T_MARKET
  add constraint PK_MARKET_ID primary key (ID)
  using index 
  tablespace USERS
  pctfree 10
  initrans 2
  maxtrans 255
  storage
  (
    initial 64K
    next 1M
    minextents 1
    maxextents unlimited
  );

prompt
prompt Creating table T_DEALS_HISTORY
prompt ==============================
prompt
create table FREEDOM.T_DEALS_HISTORY
(
  id        NUMBER not null,
  id_market NUMBER not null,
  buy_sell  NVARCHAR2(4) not null,
  id_load   NUMBER,
  cur_from  VARCHAR2(10) not null,
  rate      NUMBER not null,
  cur_to    VARCHAR2(10) not null,
  amount    NUMBER not null,
  dt        DATE
)
partition by range (DT) interval (NUMTODSINTERVAL(7,'DAY'))
(
  partition SYS_P41 values less than (TO_DATE(' 2012-01-01 00:00:00', 'SYYYY-MM-DD HH24:MI:SS', 'NLS_CALENDAR=GREGORIAN'))
    tablespace USERS
    pctfree 10
    initrans 1
    maxtrans 255
    storage
    (
      initial 64K
      next 1M
      minextents 1
      maxextents unlimited
    ),
  partition SYS_P61 values less than (TO_DATE(' 2013-12-22 00:00:00', 'SYYYY-MM-DD HH24:MI:SS', 'NLS_CALENDAR=GREGORIAN'))
    tablespace USERS
    pctfree 10
    initrans 1
    maxtrans 255
    storage
    (
      initial 8M
      next 1M
      minextents 1
      maxextents unlimited
    ),
  partition SYS_P81 values less than (TO_DATE(' 2013-12-29 00:00:00', 'SYYYY-MM-DD HH24:MI:SS', 'NLS_CALENDAR=GREGORIAN'))
    tablespace USERS
    pctfree 10
    initrans 1
    maxtrans 255
    storage
    (
      initial 8M
      next 1M
      minextents 1
      maxextents unlimited
    ),
  partition SYS_P101 values less than (TO_DATE(' 2014-01-05 00:00:00', 'SYYYY-MM-DD HH24:MI:SS', 'NLS_CALENDAR=GREGORIAN'))
    tablespace USERS
    pctfree 10
    initrans 1
    maxtrans 255
    storage
    (
      initial 8M
      next 1M
      minextents 1
      maxextents unlimited
    ),
  partition SYS_P121 values less than (TO_DATE(' 2014-01-12 00:00:00', 'SYYYY-MM-DD HH24:MI:SS', 'NLS_CALENDAR=GREGORIAN'))
    tablespace USERS
    pctfree 10
    initrans 1
    maxtrans 255
    storage
    (
      initial 8M
      next 1M
      minextents 1
      maxextents unlimited
    ),
  partition SYS_P141 values less than (TO_DATE(' 2014-01-19 00:00:00', 'SYYYY-MM-DD HH24:MI:SS', 'NLS_CALENDAR=GREGORIAN'))
    tablespace USERS
    pctfree 10
    initrans 1
    maxtrans 255
    storage
    (
      initial 8M
      next 1M
      minextents 1
      maxextents unlimited
    ),
  partition SYS_P161 values less than (TO_DATE(' 2014-01-26 00:00:00', 'SYYYY-MM-DD HH24:MI:SS', 'NLS_CALENDAR=GREGORIAN'))
    tablespace USERS
    pctfree 10
    initrans 1
    maxtrans 255
    storage
    (
      initial 8M
      next 1M
      minextents 1
      maxextents unlimited
    ),
  partition SYS_P181 values less than (TO_DATE(' 2014-02-02 00:00:00', 'SYYYY-MM-DD HH24:MI:SS', 'NLS_CALENDAR=GREGORIAN'))
    tablespace USERS
    pctfree 10
    initrans 1
    maxtrans 255
    storage
    (
      initial 8M
      next 1M
      minextents 1
      maxextents unlimited
    )
);
create index FREEDOM.CURR_FROM_FK_IND on FREEDOM.T_DEALS_HISTORY (CUR_FROM)
  tablespace USERS
  pctfree 10
  initrans 2
  maxtrans 255
  storage
  (
    initial 64K
    next 1M
    minextents 1
    maxextents unlimited
  );
create index FREEDOM.CURR_TO_FK_IND on FREEDOM.T_DEALS_HISTORY (CUR_TO)
  tablespace USERS
  pctfree 10
  initrans 2
  maxtrans 255
  storage
  (
    initial 64K
    next 1M
    minextents 1
    maxextents unlimited
  );
create index FREEDOM.DT_IND on FREEDOM.T_DEALS_HISTORY (DT)
  tablespace USERS
  pctfree 10
  initrans 2
  maxtrans 255
  storage
  (
    initial 64K
    next 1M
    minextents 1
    maxextents unlimited
  );
create index FREEDOM.ID_LOAD_IND on FREEDOM.T_DEALS_HISTORY (ID_LOAD)
  tablespace USERS
  pctfree 10
  initrans 2
  maxtrans 255
  storage
  (
    initial 64K
    next 1M
    minextents 1
    maxextents unlimited
  );
create index FREEDOM.MARKET_FK_IND on FREEDOM.T_DEALS_HISTORY (ID_MARKET)
  tablespace USERS
  pctfree 10
  initrans 2
  maxtrans 255
  storage
  (
    initial 64K
    next 1M
    minextents 1
    maxextents unlimited
  );
alter table FREEDOM.T_DEALS_HISTORY
  add constraint ID_PK_IND primary key (ID)
  using index 
  tablespace USERS
  pctfree 10
  initrans 2
  maxtrans 255
  storage
  (
    initial 64K
    next 1M
    minextents 1
    maxextents unlimited
  );
alter table FREEDOM.T_DEALS_HISTORY
  add constraint MARKET_FK foreign key (ID_MARKET)
  references FREEDOM.T_MARKET (ID);

prompt
prompt Creating table T_DEALS_TO_PROCESS
prompt =================================
prompt
create table FREEDOM.T_DEALS_TO_PROCESS
(
  id          NUMBER,
  id_load     NUMBER,
  buy_id      NUMBER not null,
  sell_id     NUMBER not null,
  dealk       NUMBER,
  deal_type   NUMBER,
  buy_rate    NUMBER not null,
  sell_rate   NUMBER not null,
  buy_market  NUMBER not null,
  sell_market NUMBER not null,
  cur_from    VARCHAR2(10) not null,
  cur_to      VARCHAR2(10) not null,
  buy_amount  NUMBER not null,
  sell_amount NUMBER not null
)
tablespace USERS
  pctfree 10
  initrans 1
  maxtrans 255
  storage
  (
    initial 64K
    next 1M
    minextents 1
    maxextents unlimited
  );

prompt
prompt Creating table T_JOB_COMMUNICATION
prompt ==================================
prompt
create table FREEDOM.T_JOB_COMMUNICATION
(
  id             NUMBER not null,
  id_market_deal NUMBER not null,
  id_pair_deal   NUMBER not null,
  status         VARCHAR2(30) not null,
  msg            VARCHAR2(200),
  manager_id     NUMBER not null
)
tablespace USERS
  pctfree 10
  initrans 1
  maxtrans 255
  storage
  (
    initial 64K
    next 1M
    minextents 1
    maxextents unlimited
  );

prompt
prompt Creating table T_LOCK_HANDLES
prompt =============================
prompt
create table FREEDOM.T_LOCK_HANDLES
(
  seq_name VARCHAR2(32) not null,
  handle   VARCHAR2(500) not null
)
tablespace USERS
  pctfree 10
  initrans 1
  maxtrans 255
  storage
  (
    initial 64K
    next 1M
    minextents 1
    maxextents unlimited
  );

prompt
prompt Creating table T_LOG
prompt ====================
prompt
create table FREEDOM.T_LOG
(
  id  NUMBER not null,
  dt  DATE not null,
  msg VARCHAR2(200) not null
)
tablespace USERS
  pctfree 10
  initrans 1
  maxtrans 255
  storage
  (
    initial 64K
    next 1M
    minextents 1
    maxextents unlimited
  );
create index FREEDOM.T_LOG_DT_IND on FREEDOM.T_LOG (DT)
  tablespace USERS
  pctfree 10
  initrans 2
  maxtrans 255
  storage
  (
    initial 64K
    next 1M
    minextents 1
    maxextents unlimited
  );
create index FREEDOM.T_LOG_MSG_IND on FREEDOM.T_LOG (MSG)
  tablespace USERS
  pctfree 10
  initrans 2
  maxtrans 255
  storage
  (
    initial 64K
    next 1M
    minextents 1
    maxextents unlimited
  );

prompt
prompt Creating table T_MARKET_BALANCE
prompt ===============================
prompt
create table FREEDOM.T_MARKET_BALANCE
(
  id_market       NUMBER not null,
  cur_code        VARCHAR2(20) not null,
  init_balance    NUMBER not null,
  current_balance NUMBER not null
)
tablespace USERS
  pctfree 10
  initrans 1
  maxtrans 255
  storage
  (
    initial 64K
    next 1M
    minextents 1
    maxextents unlimited
  );

prompt
prompt Creating table T_MARKET_BAL_HISTORY
prompt ===================================
prompt
create table FREEDOM.T_MARKET_BAL_HISTORY
(
  id          NUMBER not null,
  id_load     NUMBER not null,
  id_market   NUMBER not null,
  cur_from    VARCHAR2(20) not null,
  amount_from NUMBER not null,
  cur_to      VARCHAR2(20) not null,
  amount_to   NUMBER not null,
  id_deal     NUMBER not null
)
tablespace USERS
  pctfree 10
  initrans 1
  maxtrans 255
  storage
  (
    initial 64K
    next 1M
    minextents 1
    maxextents unlimited
  );
alter table FREEDOM.T_MARKET_BAL_HISTORY
  add constraint BAL_HISTORY_PK primary key (ID)
  using index 
  tablespace USERS
  pctfree 10
  initrans 2
  maxtrans 255
  storage
  (
    initial 64K
    next 1M
    minextents 1
    maxextents unlimited
  );

prompt
prompt Creating table T_MARKET_COMMISION
prompt =================================
prompt
create table FREEDOM.T_MARKET_COMMISION
(
  id_market     NUMBER not null,
  cur_code      VARCHAR2(20) not null,
  commision_cur NUMBER not null,
  commision_prc NUMBER default 0 not null,
  min_val       NUMBER
)
tablespace USERS
  pctfree 10
  initrans 1
  maxtrans 255
  storage
  (
    initial 64K
    next 1M
    minextents 1
    maxextents unlimited
  );
comment on table FREEDOM.T_MARKET_COMMISION
  is 'market withdrawal commision';

prompt
prompt Creating table T_MARKET_CONNECTION
prompt ==================================
prompt
create table FREEDOM.T_MARKET_CONNECTION
(
  id_market  NUMBER not null,
  call_limit NUMBER,
  last_call  DATE
)
tablespace USERS
  pctfree 10
  initrans 1
  maxtrans 255
  storage
  (
    initial 64K
    next 1M
    minextents 1
    maxextents unlimited
  );

prompt
prompt Creating table T_PAIRS
prompt ======================
prompt
create table FREEDOM.T_PAIRS
(
  cur_from VARCHAR2(10) not null,
  cur_to   VARCHAR2(10) not null,
  constraint PK primary key (CUR_FROM, CUR_TO)
)
organization index;

prompt
prompt Creating table T_RISKY_DEALS
prompt ============================
prompt
create table FREEDOM.T_RISKY_DEALS
(
  id_load        NUMBER not null,
  id_market      NUMBER not null,
  id_deal        NUMBER not null,
  deal_dt        DATE not null,
  ordered_amount NUMBER not null,
  state          VARCHAR2(30) not null,
  rate           NUMBER not null,
  deal_type      VARCHAR2(10) not null
)
tablespace USERS
  pctfree 10
  initrans 1
  maxtrans 255
  storage
  (
    initial 64K
    next 1M
    minextents 1
    maxextents unlimited
  );
create index FREEDOM.I_RISK_D_DEAL on FREEDOM.T_RISKY_DEALS (ID_DEAL)
  tablespace USERS
  pctfree 10
  initrans 2
  maxtrans 255
  storage
  (
    initial 64K
    next 1M
    minextents 1
    maxextents unlimited
  );
create index FREEDOM.I_RISK_D_DT on FREEDOM.T_RISKY_DEALS (DEAL_DT)
  tablespace USERS
  pctfree 10
  initrans 2
  maxtrans 255
  storage
  (
    initial 64K
    next 1M
    minextents 1
    maxextents unlimited
  );
create index FREEDOM.I_RISK_D_LOAD_ID on FREEDOM.T_RISKY_DEALS (ID_LOAD)
  tablespace USERS
  pctfree 10
  initrans 2
  maxtrans 255
  storage
  (
    initial 64K
    next 1M
    minextents 1
    maxextents unlimited
  );
create index FREEDOM.I_RISK_D_STATE on FREEDOM.T_RISKY_DEALS (STATE)
  tablespace USERS
  pctfree 10
  initrans 2
  maxtrans 255
  storage
  (
    initial 64K
    next 1M
    minextents 1
    maxextents unlimited
  );

prompt
prompt Creating table T_RISKY_DEALS_CLOSED
prompt ===================================
prompt
create table FREEDOM.T_RISKY_DEALS_CLOSED
(
  id_deal_open     NUMBER not null,
  id_deal          NUMBER,
  id_load          NUMBER,
  id_market        NUMBER not null,
  dt               DATE not null,
  rate             NUMBER not null,
  amount           NUMBER not null,
  state            VARCHAR2(30) not null,
  rollback_atempts NUMBER,
  o_deal_type      VARCHAR2(10) not null
)
tablespace USERS
  pctfree 10
  initrans 1
  maxtrans 255
  storage
  (
    initial 64K
    next 1M
    minextents 1
    maxextents unlimited
  );

prompt
prompt Creating table T_SHUHART_GROUPS
prompt ===============================
prompt
create table FREEDOM.T_SHUHART_GROUPS
(
  n  NUMBER,
  d2 NUMBER
)
tablespace USERS
  pctfree 10
  initrans 1
  maxtrans 255
  storage
  (
    initial 64K
    next 1M
    minextents 1
    maxextents unlimited
  );

prompt
prompt Creating table T_SYSTEM_PARAMS
prompt ==============================
prompt
create table FREEDOM.T_SYSTEM_PARAMS
(
  param_code  VARCHAR2(20) not null,
  param_value VARCHAR2(20),
  param_desc  VARCHAR2(200)
)
tablespace USERS
  pctfree 10
  initrans 1
  maxtrans 255
  storage
  (
    initial 64K
    next 1M
    minextents 1
    maxextents unlimited
  );

prompt
prompt Creating table T_TEST
prompt =====================
prompt
create table FREEDOM.T_TEST
(
  id  NUMBER,
  val VARCHAR2(1),
  id2 NUMBER
)
tablespace USERS
  pctfree 10
  initrans 1
  maxtrans 255
  storage
  (
    initial 64K
    next 1M
    minextents 1
    maxextents unlimited
  );

prompt
prompt Creating table T_TESTING_DEALS
prompt ==============================
prompt
create table FREEDOM.T_TESTING_DEALS
(
  id_market    NUMBER,
  id_deal_open NUMBER,
  rate_open    NUMBER,
  amount_open  NUMBER,
  amount_done  NUMBER,
  id_load      NUMBER,
  dt           DATE
)
tablespace USERS
  pctfree 10
  initrans 1
  maxtrans 255
  storage
  (
    initial 64K
    next 1M
    minextents 1
    maxextents unlimited
  );

prompt
prompt Creating table T_TESTING_MARKET_BALANCE
prompt =======================================
prompt
create table FREEDOM.T_TESTING_MARKET_BALANCE
(
  id_market       NUMBER not null,
  cur_code        VARCHAR2(20) not null,
  init_balance    NUMBER not null,
  current_balance NUMBER not null
)
tablespace USERS
  pctfree 10
  initrans 1
  maxtrans 255
  storage
  (
    initial 64K
    next 1M
    minextents 1
    maxextents unlimited
  );
alter table FREEDOM.T_TESTING_MARKET_BALANCE
  add constraint ABOVE_ZERO
  check (current_balance >= 0);

prompt
prompt Creating sequence JOBS_PROCCESS_THE_DEAL_ID
prompt ===========================================
prompt
create sequence FREEDOM.JOBS_PROCCESS_THE_DEAL_ID
minvalue 1
maxvalue 9999999999999999999999999999
start with 143
increment by 1
cache 20
order;

prompt
prompt Creating sequence SEQ_BITFINEX_API_NONCE
prompt ========================================
prompt
create sequence FREEDOM.SEQ_BITFINEX_API_NONCE
minvalue 1
maxvalue 9999999999999999999999999999
start with 3556
increment by 1
cache 20
order;

prompt
prompt Creating sequence SEQ_BTC_E_API_NONCE
prompt =====================================
prompt
create sequence FREEDOM.SEQ_BTC_E_API_NONCE
minvalue 1
maxvalue 9999999999999999999999999999
start with 8119
increment by 1
cache 20
order;

prompt
prompt Creating sequence SEQ_BTER_API_NONCE
prompt ====================================
prompt
create sequence FREEDOM.SEQ_BTER_API_NONCE
minvalue 1
maxvalue 9999999999999999999999999999
start with 301
increment by 1
cache 20
order;

prompt
prompt Creating sequence SEQ_COINS_E_API_NONCE
prompt =======================================
prompt
create sequence FREEDOM.SEQ_COINS_E_API_NONCE
minvalue 1
maxvalue 9999999999999999999999999999
start with 7847
increment by 1
cache 20
order;

prompt
prompt Creating sequence SEQ_CRYPTO_TR_API_NONCE
prompt =========================================
prompt
create sequence FREEDOM.SEQ_CRYPTO_TR_API_NONCE
minvalue 1
maxvalue 9999999999999999999999999999
start with 6305
increment by 1
cache 20
order;

prompt
prompt Creating sequence SEQ_DEALS_HISTORY_PK
prompt ======================================
prompt
create sequence FREEDOM.SEQ_DEALS_HISTORY_PK
minvalue 1
maxvalue 9999999999999999999999999999
start with 14177921
increment by 1
cache 20;

prompt
prompt Creating sequence SEQ_DEALS_TO_PROCESS
prompt ======================================
prompt
create sequence FREEDOM.SEQ_DEALS_TO_PROCESS
minvalue 1
maxvalue 9999999999999999999999999999
start with 272844
increment by 1
cache 20;

prompt
prompt Creating sequence SEQ_JOB_COMM_ID
prompt =================================
prompt
create sequence FREEDOM.SEQ_JOB_COMM_ID
minvalue 1
maxvalue 9999999999999999999999999999
start with 1107
increment by 1
cache 20;

prompt
prompt Creating sequence SEQ_LOAD_ID
prompt =============================
prompt
create sequence FREEDOM.SEQ_LOAD_ID
minvalue 1
maxvalue 9999999999999999999999999999
start with 111570
increment by 1
cache 20;

prompt
prompt Creating sequence SEQ_MANAGER_ID
prompt ================================
prompt
create sequence FREEDOM.SEQ_MANAGER_ID
minvalue 1
maxvalue 9999999999999999999999999999
start with 92356
increment by 1
cache 20;

prompt
prompt Creating sequence SEQ_MARKET_BAL_HISTORY
prompt ========================================
prompt
create sequence FREEDOM.SEQ_MARKET_BAL_HISTORY
minvalue 1
maxvalue 9999999999999999999999999999
start with 37401
increment by 1
cache 20;

prompt
prompt Creating sequence SEQ_T_CURRENCIES
prompt ==================================
prompt
create sequence FREEDOM.SEQ_T_CURRENCIES
minvalue 1
maxvalue 9999999999999999999999999999
start with 21
increment by 1
cache 20;

prompt
prompt Creating sequence SEQ_T_LOG_ID
prompt ==============================
prompt
create sequence FREEDOM.SEQ_T_LOG_ID
minvalue 1
maxvalue 9999999999999999999999999999
start with 29872
increment by 1
cache 20;

prompt
prompt Creating sequence SEQ_VIRCUREX_API_ID
prompt =====================================
prompt
create sequence FREEDOM.SEQ_VIRCUREX_API_ID
minvalue 1
maxvalue 9999999999999999999999999999
start with 7837
increment by 1
cache 20
order;

prompt
prompt Creating sequence T_MARKET_PK_SQ
prompt ================================
prompt
create sequence FREEDOM.T_MARKET_PK_SQ
minvalue 1
maxvalue 9999999999999999999999999999
start with 61
increment by 1
cache 20;

prompt
prompt Creating synonym T_RISK_MARKET_BALANCE
prompt ======================================
prompt
create or replace synonym FREEDOM.T_RISK_MARKET_BALANCE
  for FREEDOM.T_TESTING_MARKET_BALANCE;

prompt
prompt Creating package PK_TOOL
prompt ========================
prompt
create or replace package freedom.pk_tool is

  -- Author  : RELAXIMUS
  -- Created : 05.12.2013 22:23:06
  -- Purpose : dealing with adapters of markets
  type TBookStr is record (
       buysell varchar2(4),
       rate number,
       amount number
       );
  type TBookStrArr is table of TBookStr;
  -- pairs to process
  type TDealsProc is record (
       buy_deal_id number,
       sell_deal_id number,
       balanced_profit number,
       deal_k number
       );
  type TDealsProcArr is table of TDealsProc;
  
  -- amounts of markets
  type TAmounts is record (
       cur varchar2(20),
       amount number
       );
  type TAmountsArr is table of TAmounts;
  
  procedure log(a_msg varchar2);
 
  function deal_K(buy_deal_rate number, 
                 sell_deal_rate number, 
                 buy_market_fee number, 
                 sell_market_fee number, 
                 buy_market_comm_cur number, 
                 sell_market_comm_cur number, 
                 buy_market_comm_pct number, 
                 sell_market_comm_pct number, 
                 buying_cur_initial_amount number, 
                 selling_cur_initial_amount number
                 
  ) return number;
  
  function balanced_deal_profit(buy_deal_rate number, sell_deal_rate number, buy_market_fee number, sell_market_fee number) return number;
  
  -- Public procedure for geting next portion of deals
  procedure get_deals_history(a_market_id number DEFAULT NULL);
  -- parallel version
  procedure get_deals_history_v2;
  
  -- Collecting profit deals at the moment
 procedure load_new_profit(a_id_load number default null);

 -- proceeding deals 
 procedure process_new_profit;
 -- proccesing one deal in a job
 procedure procces_the_deal(a_mn varchar2,
                             a_mid number, 
                             a_buysell varchar2, 
                             a_rate    number,
                             a_cur_from varchar2, 
                             a_cur_to varchar2, 
                             a_am number, 
                             a_com_id number);
 -- new version with parallel
 procedure process_new_profit_v2;
 -- supportable function
 function get_market_name(a_id number) return varchar2;
 -- helper
 procedure make_equal;
 -- returns numbers with leading 0
 function number_to_char(a_num number) return varchar2;
 -- checking freq
   procedure check_freq(a_mn varchar2) ;

end pk_tool;
/

prompt
prompt Creating view V_DEALS_TO_PROCESS
prompt ================================
prompt
create or replace force view freedom.v_deals_to_process as
select "ID_LOAD","BUY_ID","SELL_ID","DEALK","DEAL_TYPE","BUY_RATE","SELL_RATE","BUY_MARKET","SELL_MARKET","CUR_FROM","CUR_TO",buy_amount,sell_amount
from (
     select     h_buy.id_load,
           h_buy.id as buy_id,
           h_sell.id as sell_id,
           -- bussines columns
           pk_tool.balanced_deal_profit(buy_deal_rate => h_buy.rate,
                                sell_deal_rate => h_sell.rate,
                                buy_market_fee => m_buy.fee,
                                sell_market_fee => m_sell.fee) as balanced_profit,
          pk_tool.deal_K(buy_deal_rate => h_buy.rate,
                 sell_deal_rate => h_sell.rate,
                 buy_market_fee => m_buy.fee,
                 sell_market_fee => m_sell.fee,
                 buy_market_comm_cur => c_buy.commision_cur,
                 sell_market_comm_cur => c_sell.commision_cur,
                 buy_market_comm_pct => c_buy.commision_prc,
                 sell_market_comm_pct => c_sell.commision_prc,
                 buying_cur_initial_amount =>b_sell.init_balance,
                 selling_cur_initial_amount =>b_buy.init_balance) as dealk,
                 (case when (b_buy.current_balance-b_buy.init_balance)/b_buy.init_balance*100 >= (select to_number(p.param_value) from t_system_params p where p.param_code = 'balancing_pct') and
                           (b_sell.current_balance - b_sell.init_balance)/b_sell.init_balance*100 >= (select to_number(p.param_value) from t_system_params p where p.param_code = 'balancing_pct') then
                       1
                      else
                        2
                  end) as deal_type,
                 h_buy.rate as buy_rate,
                 h_sell.rate as sell_rate,
                 h_buy.id_market as buy_market,
                 h_sell.id_market as sell_market,
                 h_buy.cur_from,
                 h_buy.cur_to,
                 h_buy.amount as buy_amount,
                 h_sell.amount as sell_amount
                 /*,
                 m_buy.fee as buy_fee,
                 m_sell.fee as sell_fee,
                 c_buy.commision_cur as buy_comm_cur,
                 c_sell.commision_cur as sell_comm_cur,
                 c_buy.commision_prc as buy_comm_pct,
                 c_sell.commision_prc as sell_comm_pct,
                 b_sell.init_balance as sell_bal,
                 b_buy.init_balance as buy_bal*/
     from t_deals_history h_buy,
          t_market m_buy,
          t_market_commision c_buy,
          t_market_balance b_buy,
          t_deals_history h_sell,
          t_market m_sell,
          t_market_commision c_sell,
          t_market_balance b_sell
     where h_buy.id_load = h_sell.id_load
       and h_buy.buy_sell = 'buy'
       and h_sell.buy_sell = 'sell'
       and h_sell.rate < h_buy.rate
       -- markets joins
       and m_buy.id = h_buy.id_market
       and m_sell.id = h_sell.id_market
       and m_buy.enabled = 'Y'
       --
       and m_sell.id = c_sell.id_market
       and c_sell.cur_code = h_sell.cur_from
       and m_sell.enabled = 'Y'
       --
       and m_buy.id = c_buy.id_market
       and c_buy.cur_code = h_buy.cur_to
       -- balances joins
       and b_buy.id_market = m_buy.id
       and b_buy.cur_code = h_buy.cur_to
       --
       and b_sell.id_market = m_sell.id
       and b_sell.cur_code = h_sell.cur_from
) t
where (t.balanced_profit > 0 and t.deal_type =1) OR
      (t.dealk > (select p.param_value from t_system_params p where p.param_code = 'deal k') and t.deal_type = 2)
      -- same web call just can't be done quickly
      and t.buy_market <> t.sell_market
order by t.deal_type, t.dealk desc
;

prompt
prompt Creating view V_PROFIT
prompt ======================
prompt
create or replace force view freedom.v_profit as
select b.cur_code, sum(b.current_balance-b.init_balance) as profit
from t_market_balance b
group by b.cur_code;

prompt
prompt Creating view V_PROFIT_MARKET
prompt =============================
prompt
create or replace force view freedom.v_profit_market as
with
t as (select b.id_market, sum((b.current_balance-b.init_balance)/b.init_balance) as pct
from t_market_balance b
group by id_market),
t_pct as (
select t.pct/(select sum(t.pct) from t where t.pct >0) as pct, t.id_market from t)
select b.id_market, b.cur_code, t_pct.pct*(select v.profit from v_profit v where v.cur_code=b.cur_code) as profit from t_pct,t_market_balance b
where t_pct.id_market = b.id_market
and   t_pct.pct >0
and b.current_balance-b.init_balance > 0;

prompt
prompt Creating package PK_BTC_E
prompt =========================
prompt
create or replace package freedom.pk_btc_e is

  -- Author  : RELAXIMUS
  -- Created : 17.12.2013 22:16:09
  -- Purpose : btc-e trading
  
  -- authenication data
  g_api_secret varchar2(100) := '7982cabbc1a8f3c82278a7b3227d4f549278cc6bdf4aead52eeac36a17d404ae';
  g_api_key    varchar2(100) := 'Z1R0LMHG-QOH6XBOU-ECQ39PZI-VOPZW6SR-2SVKWWL8';
  -- book retriever
  function book(a_code_from varchar2, a_code_to varchar2) return pk_tool.TBookStrArr pipelined;
  -- balance retriever
  function balance return pk_tool.TAmountsArr pipelined;
  -- order creation
  function make_order(a_buysell varchar2, a_cur_from varchar2, a_cur_to varchar2, a_rate number, a_amount number) return number;
  -- cancelation of order
  function cancel_order(a_id number) return varchar2;

end pk_btc_e;
/

prompt
prompt Creating package PK_COINS_E
prompt ===========================
prompt
create or replace package freedom.pk_coins_e is

  -- Author  : RELAXIMUS
  -- Created : 06.12.2013 23:03:19
  -- Purpose : bitfinex market adopter
  -- authenication data
  g_api_secret varchar2(100) := 'd443b901423794ca61716dd54877b4677b41deae63beda65a829fb1ce8f16f70';
  g_api_key    varchar2(100) := '38f246950b5c0df210d0d3c35046ac871d342286359ab92fbeaaed25';
  -- book retriever
  function book(a_code_from varchar2, a_code_to varchar2) return pk_tool.TBookStrArr pipelined;
  -- balance retriever
  function balance return pk_tool.TAmountsArr pipelined;
  -- order creation
  function make_order(a_buysell varchar2, a_cur_from varchar2, a_cur_to varchar2, a_rate number, a_amount number) return varchar2;
  -- cancelation of order
  function cancel_order(a_id varchar2,a_cur_from varchar2, a_cur_to varchar2) return varchar2;

end pk_coins_e;
/

prompt
prompt Creating package PK_CRYPTO_TRADE
prompt ================================
prompt
create or replace package freedom.pk_crypto_trade is

    -- Author  : RELAXIMUS
  -- Created : 06.12.2013 23:03:19
  -- Purpose : crypto-trade market adopter
  -- authenication data
  g_api_secret varchar2(100) := '87b79215b3e63be77da4f8e1484dddbba5c1bc19';
  g_api_key    varchar2(100) := '0ACB416E-464D-9121-DA2E-09BBC2AE2395';

  -- book retriever
  function book(a_code_from varchar2, a_code_to varchar2) return pk_tool.TBookStrArr pipelined;
  -- balance retriever
  function balance return pk_tool.TAmountsArr pipelined;
  -- making orders
  function make_order(a_buysell varchar2, a_cur_from varchar2, a_cur_to varchar2, a_rate number, a_amount number) return number;
  -- cancelation of order
  function cancel_order(a_id number) return varchar2;
  -- order info
--  function get_status_order(a_id number) return varchar2;

end pk_crypto_trade;
/

prompt
prompt Creating package PK_VIRCUREX
prompt ============================
prompt
create or replace package freedom.pk_vircurex is

  -- Author  : RELAXIMUS
  -- Created : 07.12.2013 21:11:19
  -- Purpose : bter market adopter
  g_get_bal_api_key varchar2(30):='328103O8DA595Ty';
  g_mk_order_api_key varchar2(30):='3d1I2253hnkA855';
  g_release_api_key varchar2(30):='ZVYDSz8Bc3q6EtT';
  g_del_order_api_key varchar2(30):='YxyG9Y2604736tM';
  -- book retriever
  function book(a_code_from varchar2, a_code_to varchar2) return pk_tool.TBookStrArr pipelined;
  -- balance retriever
  function balance return pk_tool.TAmountsArr pipelined;
  -- order creation
  function make_order(a_buysell varchar2, a_cur_from varchar2, a_cur_to varchar2, a_rate number, a_amount number) return number;
  -- order cancelation
  function cancel_order(a_id number, a_otype number default 1) return varchar2;

end pk_vircurex;
/

prompt
prompt Creating view V_REAL_BALANCES
prompt =============================
prompt
create or replace force view freedom.v_real_balances as
select 'coins_e' as market_name, cur,amount from table(pk_coins_e.balance)
union
select 'vircurex', cur,amount from table(pk_vircurex.balance)
union
select 'btc_e', cur,amount from table(pk_btc_e.balance)
union
select 'crypto_trade', cur,amount from table(pk_crypto_trade.balance);

prompt
prompt Creating java source BASE64
prompt ===========================
prompt
create or replace and compile java source named FREEDOM.base64 as
import java.io.ByteArrayInputStream;
import java.io.ByteArrayOutputStream;
import java.io.IOException;
import java.io.InputStream;
import java.io.OutputStream;

import javax.mail.MessagingException;
import javax.mail.internet.MimeUtility;

// How To Encode A String To Base64 Using Java

public class Base64 {

  public static void main(String[] args) throws MessagingException,IOException {
  }
  
  public static String encode(String test) throws MessagingException,IOException {

    ByteArrayOutputStream baos = new ByteArrayOutputStream();
    OutputStream base64OutputStream = MimeUtility.encode(baos, "base64");
    base64OutputStream.write(test.getBytes());
    base64OutputStream.close();
    return baos.toString();
  }
}
/

prompt
prompt Creating java source HMAC
prompt =========================
prompt
create or replace and compile java source named FREEDOM.hmac as
import javax.crypto.Mac;
import javax.crypto.spec.SecretKeySpec;
import java.io.UnsupportedEncodingException;
import java.security.InvalidKeyException;
import java.security.NoSuchAlgorithmException;
public class HMAC {

  public static void main(String[] args) throws Exception {
  }

  public static String hmacDigest(String msg, String keyString, String algo) {
    String digest = null;
    try {
      SecretKeySpec key = new SecretKeySpec((keyString).getBytes("UTF-8"), algo);
      Mac mac = Mac.getInstance(algo);
      mac.init(key);

      byte[] bytes = mac.doFinal(msg.getBytes("ASCII"));

      StringBuffer hash = new StringBuffer();
      for (int i = 0; i < bytes.length; i++) {
        String hex = Integer.toHexString(0xFF & bytes[i]);
        if (hex.length() == 1) {
          hash.append('0');
        }
        hash.append(hex);
      }
      digest = hash.toString();
    } catch (UnsupportedEncodingException e) {
    } catch (InvalidKeyException e) {
    } catch (NoSuchAlgorithmException e) {
    }
    return digest;
  }
}
/

prompt
prompt Creating java source SHA2HASH
prompt =============================
prompt
create or replace and compile java source named FREEDOM.sha2hash as
import java.security.MessageDigest;
 
public class SHA2Hash
{
    public static void main(String[] args)throws Exception
    {
    }
    public static String get_hash(String test) throws Exception {

 
        MessageDigest md = MessageDigest.getInstance("SHA-256");
        md.update(test.getBytes());
 
        byte byteData[] = md.digest();
 
        //convert the byte to hex format method 1
        StringBuffer sb = new StringBuffer();
        for (int i = 0; i < byteData.length; i++) {
         sb.append(Integer.toString((byteData[i] & 0xff) + 0x100, 16).substring(1));
        }
 
        return sb.toString();
 
    }
}
/

prompt
prompt Creating type JSON_VALUE
prompt ========================
prompt
create or replace type freedom.json_value as object
(
  /*
  Copyright (c) 2010 Jonas Krogsboell

  Permission is hereby granted, free of charge, to any person obtaining a copy
  of this software and associated documentation files (the "Software"), to deal
  in the Software without restriction, including without limitation the rights
  to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
  copies of the Software, and to permit persons to whom the Software is
  furnished to do so, subject to the following conditions:

  The above copyright notice and this permission notice shall be included in
  all copies or substantial portions of the Software.

  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
  THE SOFTWARE.
  */

  typeval number(1), /* 1 = object, 2 = array, 3 = string, 4 = number, 5 = bool, 6 = null */
  str varchar2(32767),
  num number, /* store 1 as true, 0 as false */
  object_or_array sys.anydata, /* object or array in here */
  extended_str clob,

  /* mapping */
  mapname varchar2(4000),
  mapindx number(32),

  constructor function json_value(object_or_array sys.anydata) return self as result,
  constructor function json_value(str varchar2, esc boolean default true) return self as result,
  constructor function json_value(str clob, esc boolean default true) return self as result,
  constructor function json_value(num number) return self as result,
  constructor function json_value(b boolean) return self as result,
  constructor function json_value return self as result,
  static function makenull return json_value,

  member function get_type return varchar2,
  member function get_string(max_byte_size number default null, max_char_size number default null) return varchar2,
  member procedure get_string(self in json_value, buf in out nocopy clob),
  member function get_number return number,
  member function get_bool return boolean,
  member function get_null return varchar2,

  member function is_object return boolean,
  member function is_array return boolean,
  member function is_string return boolean,
  member function is_number return boolean,
  member function is_bool return boolean,
  member function is_null return boolean,

  /* Output methods */
  member function to_char(spaces boolean default true, chars_per_line number default 0) return varchar2,
  member procedure to_clob(self in json_value, buf in out nocopy clob, spaces boolean default false, chars_per_line number default 0, erase_clob boolean default true),
  member procedure print(self in json_value, spaces boolean default true, chars_per_line number default 8192, jsonp varchar2 default null), --32512 is maximum
  member procedure htp(self in json_value, spaces boolean default false, chars_per_line number default 0, jsonp varchar2 default null),

  member function value_of(self in json_value, max_byte_size number default null, max_char_size number default null) return varchar2

) not final;
/

prompt
prompt Creating type JSON_VALUE_ARRAY
prompt ==============================
prompt
create or replace type freedom.json_value_array as table of json_value;
/

prompt
prompt Creating type JSON_LIST
prompt =======================
prompt
create or replace type freedom.json_list as object (
  /*
  Copyright (c) 2010 Jonas Krogsboell

  Permission is hereby granted, free of charge, to any person obtaining a copy
  of this software and associated documentation files (the "Software"), to deal
  in the Software without restriction, including without limitation the rights
  to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
  copies of the Software, and to permit persons to whom the Software is
  furnished to do so, subject to the following conditions:

  The above copyright notice and this permission notice shall be included in
  all copies or substantial portions of the Software.

  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
  THE SOFTWARE.
  */

  list_data json_value_array,
  constructor function json_list return self as result,
  constructor function json_list(str varchar2) return self as result,
  constructor function json_list(str clob) return self as result,
  constructor function json_list(cast json_value) return self as result,

  member procedure append(self in out nocopy json_list, elem json_value, position pls_integer default null),
  member procedure append(self in out nocopy json_list, elem varchar2, position pls_integer default null),
  member procedure append(self in out nocopy json_list, elem number, position pls_integer default null),
  member procedure append(self in out nocopy json_list, elem boolean, position pls_integer default null),
  member procedure append(self in out nocopy json_list, elem json_list, position pls_integer default null),

  member procedure replace(self in out nocopy json_list, position pls_integer, elem json_value),
  member procedure replace(self in out nocopy json_list, position pls_integer, elem varchar2),
  member procedure replace(self in out nocopy json_list, position pls_integer, elem number),
  member procedure replace(self in out nocopy json_list, position pls_integer, elem boolean),
  member procedure replace(self in out nocopy json_list, position pls_integer, elem json_list),

  member function count return number,
  member procedure remove(self in out nocopy json_list, position pls_integer),
  member procedure remove_first(self in out nocopy json_list),
  member procedure remove_last(self in out nocopy json_list),
  member function get(position pls_integer) return json_value,
  member function head return json_value,
  member function last return json_value,
  member function tail return json_list,

  /* Output methods */
  member function to_char(spaces boolean default true, chars_per_line number default 0) return varchar2,
  member procedure to_clob(self in json_list, buf in out nocopy clob, spaces boolean default false, chars_per_line number default 0, erase_clob boolean default true),
  member procedure print(self in json_list, spaces boolean default true, chars_per_line number default 8192, jsonp varchar2 default null), --32512 is maximum
  member procedure htp(self in json_list, spaces boolean default false, chars_per_line number default 0, jsonp varchar2 default null),

  /* json path */
  member function path(json_path varchar2, base number default 1) return json_value,
  /* json path_put */
  member procedure path_put(self in out nocopy json_list, json_path varchar2, elem json_value, base number default 1),
  member procedure path_put(self in out nocopy json_list, json_path varchar2, elem varchar2  , base number default 1),
  member procedure path_put(self in out nocopy json_list, json_path varchar2, elem number    , base number default 1),
  member procedure path_put(self in out nocopy json_list, json_path varchar2, elem boolean   , base number default 1),
  member procedure path_put(self in out nocopy json_list, json_path varchar2, elem json_list , base number default 1),

  /* json path_remove */
  member procedure path_remove(self in out nocopy json_list, json_path varchar2, base number default 1),

  member function to_json_value return json_value
  /* --backwards compatibility
  ,
  member procedure add_elem(self in out nocopy json_list, elem json_value, position pls_integer default null),
  member procedure add_elem(self in out nocopy json_list, elem varchar2, position pls_integer default null),
  member procedure add_elem(self in out nocopy json_list, elem number, position pls_integer default null),
  member procedure add_elem(self in out nocopy json_list, elem boolean, position pls_integer default null),
  member procedure add_elem(self in out nocopy json_list, elem json_list, position pls_integer default null),

  member procedure set_elem(self in out nocopy json_list, position pls_integer, elem json_value),
  member procedure set_elem(self in out nocopy json_list, position pls_integer, elem varchar2),
  member procedure set_elem(self in out nocopy json_list, position pls_integer, elem number),
  member procedure set_elem(self in out nocopy json_list, position pls_integer, elem boolean),
  member procedure set_elem(self in out nocopy json_list, position pls_integer, elem json_list),

  member procedure remove_elem(self in out nocopy json_list, position pls_integer),
  member function get_elem(position pls_integer) return json_value,
  member function get_first return json_value,
  member function get_last return json_value
--  */

) not final;
/

prompt
prompt Creating type JSON
prompt ==================
prompt
create or replace type freedom.json as object (
  /*
  Copyright (c) 2010 Jonas Krogsboell

  Permission is hereby granted, free of charge, to any person obtaining a copy
  of this software and associated documentation files (the "Software"), to deal
  in the Software without restriction, including without limitation the rights
  to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
  copies of the Software, and to permit persons to whom the Software is
  furnished to do so, subject to the following conditions:

  The above copyright notice and this permission notice shall be included in
  all copies or substantial portions of the Software.

  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
  THE SOFTWARE.
  */

  /* Variables */
  json_data json_value_array,
  check_for_duplicate number,

  /* Constructors */
  constructor function json return self as result,
  constructor function json(str varchar2) return self as result,
  constructor function json(str in clob) return self as result,
  constructor function json(cast json_value) return self as result,
  constructor function json(l in out nocopy json_list) return self as result,

  /* Member setter methods */
  member procedure remove(pair_name varchar2),
  member procedure put(self in out nocopy json, pair_name varchar2, pair_value json_value, position pls_integer default null),
  member procedure put(self in out nocopy json, pair_name varchar2, pair_value varchar2, position pls_integer default null),
  member procedure put(self in out nocopy json, pair_name varchar2, pair_value number, position pls_integer default null),
  member procedure put(self in out nocopy json, pair_name varchar2, pair_value boolean, position pls_integer default null),
  member procedure check_duplicate(self in out nocopy json, v_set boolean),
  member procedure remove_duplicates(self in out nocopy json),

  /* deprecated putter use json_value */
  member procedure put(self in out nocopy json, pair_name varchar2, pair_value json, position pls_integer default null),
  member procedure put(self in out nocopy json, pair_name varchar2, pair_value json_list, position pls_integer default null),

  /* Member getter methods */
  member function count return number,
  member function get(pair_name varchar2) return json_value,
  member function get(position pls_integer) return json_value,
  member function index_of(pair_name varchar2) return number,
  member function exist(pair_name varchar2) return boolean,

  /* Output methods */
  member function to_char(spaces boolean default true, chars_per_line number default 0) return varchar2,
  member procedure to_clob(self in json, buf in out nocopy clob, spaces boolean default false, chars_per_line number default 0, erase_clob boolean default true),
  member procedure print(self in json, spaces boolean default true, chars_per_line number default 8192, jsonp varchar2 default null), --32512 is maximum
  member procedure htp(self in json, spaces boolean default false, chars_per_line number default 0, jsonp varchar2 default null),

  member function to_json_value return json_value,
  /* json path */
  member function path(json_path varchar2, base number default 1) return json_value,

  /* json path_put */
  member procedure path_put(self in out nocopy json, json_path varchar2, elem json_value, base number default 1),
  member procedure path_put(self in out nocopy json, json_path varchar2, elem varchar2  , base number default 1),
  member procedure path_put(self in out nocopy json, json_path varchar2, elem number    , base number default 1),
  member procedure path_put(self in out nocopy json, json_path varchar2, elem boolean   , base number default 1),
  member procedure path_put(self in out nocopy json, json_path varchar2, elem json_list , base number default 1),
  member procedure path_put(self in out nocopy json, json_path varchar2, elem json      , base number default 1),

  /* json path_remove */
  member procedure path_remove(self in out nocopy json, json_path varchar2, base number default 1),

  /* map functions */
  member function get_values return json_list,
  member function get_keys return json_list

) not final;
/

prompt
prompt Creating package JSON_AC
prompt ========================
prompt
create or replace package freedom.json_ac as
  --json type methods

  procedure object_remove(p_self in out nocopy json, pair_name varchar2);
  procedure object_put(p_self in out nocopy json, pair_name varchar2, pair_value json_value, position pls_integer default null);
  procedure object_put(p_self in out nocopy json, pair_name varchar2, pair_value varchar2, position pls_integer default null);
  procedure object_put(p_self in out nocopy json, pair_name varchar2, pair_value number, position pls_integer default null);
  procedure object_put(p_self in out nocopy json, pair_name varchar2, pair_value boolean, position pls_integer default null);
  procedure object_check_duplicate(p_self in out nocopy json, v_set boolean);
  procedure object_remove_duplicates(p_self in out nocopy json);

  procedure object_put(p_self in out nocopy json, pair_name varchar2, pair_value json, position pls_integer default null);
  procedure object_put(p_self in out nocopy json, pair_name varchar2, pair_value json_list, position pls_integer default null);

  function object_count(p_self in json) return number;
  function object_get(p_self in json, pair_name varchar2) return json_value;
  function object_get(p_self in json, position pls_integer) return json_value;
  function object_index_of(p_self in json, pair_name varchar2) return number;
  function object_exist(p_self in json, pair_name varchar2) return boolean;

  function object_to_char(p_self in json, spaces boolean default true, chars_per_line number default 0) return varchar2;
  procedure object_to_clob(p_self in json, buf in out nocopy clob, spaces boolean default false, chars_per_line number default 0, erase_clob boolean default true);
  procedure object_print(p_self in json, spaces boolean default true, chars_per_line number default 8192, jsonp varchar2 default null);
  procedure object_htp(p_self in json, spaces boolean default false, chars_per_line number default 0, jsonp varchar2 default null);

  function object_to_json_value(p_self in json) return json_value;
  function object_path(p_self in json, json_path varchar2, base number default 1) return json_value;

  procedure object_path_put(p_self in out nocopy json, json_path varchar2, elem json_value, base number default 1);
  procedure object_path_put(p_self in out nocopy json, json_path varchar2, elem varchar2  , base number default 1);
  procedure object_path_put(p_self in out nocopy json, json_path varchar2, elem number    , base number default 1);
  procedure object_path_put(p_self in out nocopy json, json_path varchar2, elem boolean   , base number default 1);
  procedure object_path_put(p_self in out nocopy json, json_path varchar2, elem json_list , base number default 1);
  procedure object_path_put(p_self in out nocopy json, json_path varchar2, elem json      , base number default 1);

  procedure object_path_remove(p_self in out nocopy json, json_path varchar2, base number default 1);

  function object_get_values(p_self in json) return json_list;
  function object_get_keys(p_self in json) return json_list;

  --json_list type methods
  procedure array_append(p_self in out nocopy json_list, elem json_value, position pls_integer default null);
  procedure array_append(p_self in out nocopy json_list, elem varchar2, position pls_integer default null);
  procedure array_append(p_self in out nocopy json_list, elem number, position pls_integer default null);
  procedure array_append(p_self in out nocopy json_list, elem boolean, position pls_integer default null);
  procedure array_append(p_self in out nocopy json_list, elem json_list, position pls_integer default null);

  procedure array_replace(p_self in out nocopy json_list, position pls_integer, elem json_value);
  procedure array_replace(p_self in out nocopy json_list, position pls_integer, elem varchar2);
  procedure array_replace(p_self in out nocopy json_list, position pls_integer, elem number);
  procedure array_replace(p_self in out nocopy json_list, position pls_integer, elem boolean);
  procedure array_replace(p_self in out nocopy json_list, position pls_integer, elem json_list);

  function array_count(p_self in json_list) return number;
  procedure array_remove(p_self in out nocopy json_list, position pls_integer);
  procedure array_remove_first(p_self in out nocopy json_list);
  procedure array_remove_last(p_self in out nocopy json_list);
  function array_get(p_self in json_list, position pls_integer) return json_value;
  function array_head(p_self in json_list) return json_value;
  function array_last(p_self in json_list) return json_value;
  function array_tail(p_self in json_list) return json_list;

  function array_to_char(p_self in json_list, spaces boolean default true, chars_per_line number default 0) return varchar2;
  procedure array_to_clob(p_self in json_list, buf in out nocopy clob, spaces boolean default false, chars_per_line number default 0, erase_clob boolean default true);
  procedure array_print(p_self in json_list, spaces boolean default true, chars_per_line number default 8192, jsonp varchar2 default null);
  procedure array_htp(p_self in json_list, spaces boolean default false, chars_per_line number default 0, jsonp varchar2 default null);

  function array_path(p_self in json_list, json_path varchar2, base number default 1) return json_value;
  procedure array_path_put(p_self in out nocopy json_list, json_path varchar2, elem json_value, base number default 1);
  procedure array_path_put(p_self in out nocopy json_list, json_path varchar2, elem varchar2  , base number default 1);
  procedure array_path_put(p_self in out nocopy json_list, json_path varchar2, elem number    , base number default 1);
  procedure array_path_put(p_self in out nocopy json_list, json_path varchar2, elem boolean   , base number default 1);
  procedure array_path_put(p_self in out nocopy json_list, json_path varchar2, elem json_list , base number default 1);

  procedure array_path_remove(p_self in out nocopy json_list, json_path varchar2, base number default 1);

  function array_to_json_value(p_self in json_list) return json_value;

  --json_value


  function jv_get_type(p_self in json_value) return varchar2;
  function jv_get_string(p_self in json_value, max_byte_size number default null, max_char_size number default null) return varchar2;
  procedure jv_get_string(p_self in json_value, buf in out nocopy clob);
  function jv_get_number(p_self in json_value) return number;
  function jv_get_bool(p_self in json_value) return boolean;
  function jv_get_null(p_self in json_value) return varchar2;

  function jv_is_object(p_self in json_value) return boolean;
  function jv_is_array(p_self in json_value) return boolean;
  function jv_is_string(p_self in json_value) return boolean;
  function jv_is_number(p_self in json_value) return boolean;
  function jv_is_bool(p_self in json_value) return boolean;
  function jv_is_null(p_self in json_value) return boolean;

  function jv_to_char(p_self in json_value, spaces boolean default true, chars_per_line number default 0) return varchar2;
  procedure jv_to_clob(p_self in json_value, buf in out nocopy clob, spaces boolean default false, chars_per_line number default 0, erase_clob boolean default true);
  procedure jv_print(p_self in json_value, spaces boolean default true, chars_per_line number default 8192, jsonp varchar2 default null);
  procedure jv_htp(p_self in json_value, spaces boolean default false, chars_per_line number default 0, jsonp varchar2 default null);

  function jv_value_of(p_self in json_value, max_byte_size number default null, max_char_size number default null) return varchar2;


end json_ac;
/

prompt
prompt Creating package JSON_DYN
prompt =========================
prompt
create or replace package freedom.json_dyn authid current_user as
 /*
  Copyright (c) 2010 Jonas Krogsboell

  Permission is hereby granted, free of charge, to any person obtaining a copy
  of this software and associated documentation files (the "Software"), to deal
  in the Software without restriction, including without limitation the rights
  to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
  copies of the Software, and to permit persons to whom the Software is
  furnished to do so, subject to the following conditions:

  The above copyright notice and this permission notice shall be included in
  all copies or substantial portions of the Software.

  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
  THE SOFTWARE.
  */

  null_as_empty_string   boolean not null := true;  --varchar2
  include_dates          boolean not null := true;  --date
  include_clobs          boolean not null := true;
  include_blobs          boolean not null := false;

  /* list with objects */
  function executeList(stmt varchar2, bindvar json default null, cur_num number default null) return json_list;

  /* object with lists */
  function executeObject(stmt varchar2, bindvar json default null, cur_num number default null) return json;


  /* usage example:
   * declare
   *   res json_list;
   * begin
   *   res := json_dyn.executeList(
   *            'select :bindme as one, :lala as two from dual where dummy in :arraybind',
   *            json('{bindme:"4", lala:123, arraybind:[1,2,3,"X"]}')
   *          );
   *   res.print;
   * end;
   */

/* --11g functions
  function executeList(stmt in out sys_refcursor) return json_list;
  function executeObject(stmt in out sys_refcursor) return json;
*/
end json_dyn;
/

prompt
prompt Creating package JSON_EXT
prompt =========================
prompt
create or replace package freedom.json_ext as
  /*
  Copyright (c) 2009 Jonas Krogsboell

  Permission is hereby granted, free of charge, to any person obtaining a copy
  of this software and associated documentation files (the "Software"), to deal
  in the Software without restriction, including without limitation the rights
  to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
  copies of the Software, and to permit persons to whom the Software is
  furnished to do so, subject to the following conditions:

  The above copyright notice and this permission notice shall be included in
  all copies or substantial portions of the Software.

  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
  THE SOFTWARE.
  */

  /* This package contains extra methods to lookup types and
     an easy way of adding date values in json - without changing the structure */
  function parsePath(json_path varchar2, base number default 1) return json_list;

  --JSON Path getters
  function get_json_value(obj json, v_path varchar2, base number default 1) return json_value;
  function get_string(obj json, path varchar2,       base number default 1) return varchar2;
  function get_number(obj json, path varchar2,       base number default 1) return number;
  function get_json(obj json, path varchar2,         base number default 1) return json;
  function get_json_list(obj json, path varchar2,    base number default 1) return json_list;
  function get_bool(obj json, path varchar2,         base number default 1) return boolean;

  --JSON Path putters
  procedure put(obj in out nocopy json, path varchar2, elem varchar2,   base number default 1);
  procedure put(obj in out nocopy json, path varchar2, elem number,     base number default 1);
  procedure put(obj in out nocopy json, path varchar2, elem json,       base number default 1);
  procedure put(obj in out nocopy json, path varchar2, elem json_list,  base number default 1);
  procedure put(obj in out nocopy json, path varchar2, elem boolean,    base number default 1);
  procedure put(obj in out nocopy json, path varchar2, elem json_value, base number default 1);

  procedure remove(obj in out nocopy json, path varchar2, base number default 1);

  --Pretty print with JSON Path - obsolete in 0.9.4 - obj.path(v_path).(to_char,print,htp)
  function pp(obj json, v_path varchar2) return varchar2;
  procedure pp(obj json, v_path varchar2); --using dbms_output.put_line
  procedure pp_htp(obj json, v_path varchar2); --using htp.print

  --extra function checks if number has no fraction
  function is_integer(v json_value) return boolean;

  format_string varchar2(30 char) := 'yyyy-mm-dd hh24:mi:ss';
  --extension enables json to store dates without comprimising the implementation
  function to_json_value(d date) return json_value;
  --notice that a date type in json is also a varchar2
  function is_date(v json_value) return boolean;
  --convertion is needed to extract dates
  --(json_ext.to_date will not work along with the normal to_date function - any fix will be appreciated)
  function to_date2(v json_value) return date;
  --JSON Path with date
  function get_date(obj json, path varchar2, base number default 1) return date;
  procedure put(obj in out nocopy json, path varchar2, elem date, base number default 1);

  --experimental support of binary data with base64
  function base64(binarydata blob) return json_list;
  function base64(l json_list) return blob;

  function encode(binarydata blob) return json_value;
  function decode(v json_value) return blob;

end json_ext;
/

prompt
prompt Creating package JSON_HELPER
prompt ============================
prompt
create or replace package freedom.json_helper as
  /* Example:
  set serveroutput on;
  declare
    v_a json;
    v_b json;
  begin
    v_a := json('{a:1, b:{a:null}, e:false}');
    v_b := json('{c:3, e:{}, b:{b:2}}');
    json_helper.merge(v_a, v_b).print(false);
  end;
  --
  {"a":1,"b":{"a":null,"b":2},"e":{},"c":3}
  */
  -- Recursive merge
  -- Courtesy of Matt Nolan - edited by Jonas Krogsb?ll
  function merge( p_a_json json, p_b_json json) return json;

  -- Join two lists
  -- json_helper.join(json_list('[1,2,3]'),json_list('[4,5,6]')) -> [1,2,3,4,5,6]
  function join( p_a_list json_list, p_b_list json_list) return json_list;

  -- keep only specific keys in json object
  -- json_helper.keep(json('{a:1,b:2,c:3,d:4,e:5,f:6}'),json_list('["a","f","c"]')) -> {"a":1,"f":6,"c":3}
  function keep( p_json json, p_keys json_list) return json;

  -- remove specific keys in json object
  -- json_helper.remove(json('{a:1,b:2,c:3,d:4,e:5,f:6}'),json_list('["a","f","c"]')) -> {"b":2,"d":4,"e":5}
  function remove( p_json json, p_keys json_list) return json;

  --equals
  function equals(p_v1 json_value, p_v2 json_value, exact boolean default true) return boolean;
  function equals(p_v1 json_value, p_v2 json, exact boolean default true) return boolean;
  function equals(p_v1 json_value, p_v2 json_list, exact boolean default true) return boolean;
  function equals(p_v1 json_value, p_v2 number) return boolean;
  function equals(p_v1 json_value, p_v2 varchar2) return boolean;
  function equals(p_v1 json_value, p_v2 boolean) return boolean;
  function equals(p_v1 json_value, p_v2 clob) return boolean;
  function equals(p_v1 json, p_v2 json, exact boolean default true) return boolean;
  function equals(p_v1 json_list, p_v2 json_list, exact boolean default true) return boolean;

  --contains json, json_value
  --contains json_list, json_value
  function contains(p_v1 json, p_v2 json_value, exact boolean default false) return boolean;
  function contains(p_v1 json, p_v2 json, exact boolean default false) return boolean;
  function contains(p_v1 json, p_v2 json_list, exact boolean default false) return boolean;
  function contains(p_v1 json, p_v2 number, exact boolean default false) return boolean;
  function contains(p_v1 json, p_v2 varchar2, exact boolean default false) return boolean;
  function contains(p_v1 json, p_v2 boolean, exact boolean default false) return boolean;
  function contains(p_v1 json, p_v2 clob, exact boolean default false) return boolean;

  function contains(p_v1 json_list, p_v2 json_value, exact boolean default false) return boolean;
  function contains(p_v1 json_list, p_v2 json, exact boolean default false) return boolean;
  function contains(p_v1 json_list, p_v2 json_list, exact boolean default false) return boolean;
  function contains(p_v1 json_list, p_v2 number, exact boolean default false) return boolean;
  function contains(p_v1 json_list, p_v2 varchar2, exact boolean default false) return boolean;
  function contains(p_v1 json_list, p_v2 boolean, exact boolean default false) return boolean;
  function contains(p_v1 json_list, p_v2 clob, exact boolean default false) return boolean;

end json_helper;
/

prompt
prompt Creating package JSON_ML
prompt ========================
prompt
create or replace package freedom.json_ml as
  /*
  Copyright (c) 2010 Jonas Krogsboell

  Permission is hereby granted, free of charge, to any person obtaining a copy
  of this software and associated documentation files (the "Software"), to deal
  in the Software without restriction, including without limitation the rights
  to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
  copies of the Software, and to permit persons to whom the Software is
  furnished to do so, subject to the following conditions:

  The above copyright notice and this permission notice shall be included in
  all copies or substantial portions of the Software.

  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
  THE SOFTWARE.
  */

  /* This package contains extra methods to lookup types and
     an easy way of adding date values in json - without changing the structure */

  jsonml_stylesheet xmltype := null;

  function xml2json(xml in xmltype) return json_list;
  function xmlstr2json(xmlstr in varchar2) return json_list;

end json_ml;
/

prompt
prompt Creating package JSON_PARSER
prompt ============================
prompt
create or replace package freedom.json_parser as
  /*
  Copyright (c) 2010 Jonas Krogsboell

  Permission is hereby granted, free of charge, to any person obtaining a copy
  of this software and associated documentation files (the "Software"), to deal
  in the Software without restriction, including without limitation the rights
  to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
  copies of the Software, and to permit persons to whom the Software is
  furnished to do so, subject to the following conditions:

  The above copyright notice and this permission notice shall be included in
  all copies or substantial portions of the Software.

  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
  THE SOFTWARE.
  */
  /* scanner tokens:
    '{', '}', ',', ':', '[', ']', STRING, NUMBER, TRUE, FALSE, NULL
  */
  type rToken IS RECORD (
    type_name VARCHAR2(7),
    line PLS_INTEGER,
    col PLS_INTEGER,
    data VARCHAR2(32767),
    data_overflow clob); -- max_string_size

  type lTokens is table of rToken index by pls_integer;
  type json_src is record (len number, offset number, src varchar2(32767), s_clob clob);

  json_strict boolean not null := false;

  function next_char(indx number, s in out nocopy json_src) return varchar2;
  function next_char2(indx number, s in out nocopy json_src, amount number default 1) return varchar2;

  function prepareClob(buf in clob) return json_parser.json_src;
  function prepareVarchar2(buf in varchar2) return json_parser.json_src;
  function lexer(jsrc in out nocopy json_src) return lTokens;
  procedure print_token(t rToken);

  function parser(str varchar2) return json;
  function parse_list(str varchar2) return json_list;
  function parse_any(str varchar2) return json_value;
  function parser(str clob) return json;
  function parse_list(str clob) return json_list;
  function parse_any(str clob) return json_value;
  procedure remove_duplicates(obj in out nocopy json);
  function get_version return varchar2;

end json_parser;
/

prompt
prompt Creating package JSON_PRINTER
prompt =============================
prompt
create or replace package freedom.json_printer as
  /*
  Copyright (c) 2010 Jonas Krogsboell

  Permission is hereby granted, free of charge, to any person obtaining a copy
  of this software and associated documentation files (the "Software"), to deal
  in the Software without restriction, including without limitation the rights
  to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
  copies of the Software, and to permit persons to whom the Software is
  furnished to do so, subject to the following conditions:

  The above copyright notice and this permission notice shall be included in
  all copies or substantial portions of the Software.

  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
  THE SOFTWARE.
  */
  indent_string varchar2(10 char) := '  '; --chr(9); for tab
  newline_char varchar2(2 char)   := chr(13)||chr(10); -- Windows style
  --newline_char varchar2(2) := chr(10); -- Mac style
  --newline_char varchar2(2) := chr(13); -- Linux style
  ascii_output boolean    not null := true;
  escape_solidus boolean  not null := false;

  function pretty_print(obj json, spaces boolean default true, line_length number default 0) return varchar2;
  function pretty_print_list(obj json_list, spaces boolean default true, line_length number default 0) return varchar2;
  function pretty_print_any(json_part json_value, spaces boolean default true, line_length number default 0) return varchar2;
  procedure pretty_print(obj json, spaces boolean default true, buf in out nocopy clob, line_length number default 0, erase_clob boolean default true);
  procedure pretty_print_list(obj json_list, spaces boolean default true, buf in out nocopy clob, line_length number default 0, erase_clob boolean default true);
  procedure pretty_print_any(json_part json_value, spaces boolean default true, buf in out nocopy clob, line_length number default 0, erase_clob boolean default true);

  procedure dbms_output_clob(my_clob clob, delim varchar2, jsonp varchar2 default null);
  procedure htp_output_clob(my_clob clob, jsonp varchar2 default null);
end json_printer;
/

prompt
prompt Creating package JSON_UTIL_PKG
prompt ==============================
prompt
create or replace package freedom.json_util_pkg authid current_user as

  /*

  Purpose:    JSON utilities for PL/SQL
  see http://ora-00001.blogspot.com/

  Remarks:

  Who     Date        Description
  ------  ----------  -------------------------------------
  MBR     30.01.2010  Created
  JKR     01.05.2010  Edited to fit in PL/JSON
  JKR     19.01.2011  Newest stylesheet + bugfix handling

  */

  -- generate JSON from REF Cursor
  function ref_cursor_to_json (p_ref_cursor in sys_refcursor,
                               p_max_rows in number := null,
                               p_skip_rows in number := null) return json_list;

  -- generate JSON from SQL statement
  function sql_to_json (p_sql in varchar2,
                        p_max_rows in number := null,
                        p_skip_rows in number := null) return json_list;


end json_util_pkg;
/

prompt
prompt Creating package JSON_XML
prompt =========================
prompt
create or replace package freedom.json_xml as
  /*
  Copyright (c) 2010 Jonas Krogsboell

  Permission is hereby granted, free of charge, to any person obtaining a copy
  of this software and associated documentation files (the "Software"), to deal
  in the Software without restriction, including without limitation the rights
  to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
  copies of the Software, and to permit persons to whom the Software is
  furnished to do so, subject to the following conditions:

  The above copyright notice and this permission notice shall be included in
  all copies or substantial portions of the Software.

  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
  THE SOFTWARE.
  */

  /*
  declare
    obj json := json('{a:1,b:[2,3,4],c:true}');
    x xmltype;
  begin
    obj.print;
    x := json_xml.json_to_xml(obj);
    dbms_output.put_line(x.getclobval());
  end;
  */

  function json_to_xml(obj json, tagname varchar2 default 'root') return xmltype;

end json_xml;
/

prompt
prompt Creating package PK_BITFINEX
prompt ============================
prompt
create or replace package freedom.pk_bitfinex is

  -- Author  : RELAXIMUS
  -- Created : 06.12.2013 23:03:19
  -- Purpose : bitfinex market adopter
  -- authenication data
  g_api_secret varchar2(100) := 'DLrmpUffBrhrV8GkQvAfc0CHHSxdae5sXChGa2Oq7NY';
  g_api_key    varchar2(100) := 'YJqMoJxX8w8oldCPBOgWjARNCKHE9LVr0XH0doTaas7';

  -- book retriever
  function book(a_code_from varchar2, a_code_to varchar2) return pk_tool.TBookStrArr pipelined;
  -- balance retriever
  function balance return pk_tool.TAmountsArr pipelined;
  -- making orders
  function make_order(a_buysell varchar2, a_cur_from varchar2, a_cur_to varchar2, a_rate number, a_amount number) return number;
  -- cancelation of order
  function cancel_order(a_id number) return varchar2;
  -- order info
  function get_status_order(a_id number) return varchar2;

end pk_bitfinex;
/

prompt
prompt Creating package PK_BTER
prompt ========================
prompt
create or replace package freedom.pk_bter is

  -- Author  : RELAXIMUS
  -- Created : 07.12.2013 21:11:19
  -- Purpose : bter market adopter
  -- authenication data
  g_api_secret varchar2(100) := '46df2ea0f9c92fc23ba1d2ea104d63da53f836785e67c9af09989940a206c2fe';
  g_api_key    varchar2(100) := 'AA2FD4D4-6EBE-4F66-B3F0-FD99FCCFD73B';
  -- book retriever
  function book(a_code_from varchar2, a_code_to varchar2) return pk_tool.TBookStrArr pipelined;
  -- balance retriever
  function balance return pk_tool.TAmountsArr pipelined;
  -- temp
  function query_auth(a_link varchar2, a_params varchar2 default null) return varchar2;
  -- making orders
  function make_order(a_buysell varchar2, a_cur_from varchar2, a_cur_to varchar2, a_rate number, a_amount number) return number;
   -- order info
  function get_status_order(a_id number) return varchar2;
  -- cancelation of order
  function cancel_order(a_id number) return varchar2;

end pk_bter;
/

prompt
prompt Creating package PK_CRYPTO
prompt ==========================
prompt
create or replace package freedom.pk_crypto is

  -- Author  : RELAXIMUS
  -- Created : 12.12.2013 12:03:33
  -- Purpose : working with encription
  g_hmac_sha384 varchar2(20) := 'HmacSHA384';
  g_hmac_sha512 varchar2(20) := 'HmacSHA512';
  
  function hmac(a_input_string varchar2, a_key varchar2, a_algo varchar2 ) return varchar2;  
  function base64_encode(a_msg varchar2) return varchar2;
  function sha2_hash(a_msg varchar2) return varchar2;
  
  function encode_url (url varchar2, charset varchar2) return varchar2 as
      language java name 
      'java.net.URLEncoder.encode(java.lang.String, java.lang.String) return java.lang.String';
  
end pk_crypto;
/

prompt
prompt Creating package PK_HTTP
prompt ========================
prompt
create or replace package freedom.pk_http is

  -- Author  : RELAXIMUS
  -- Created : 05.12.2013 20:58:56
  -- Purpose : lowest level of http servies
  
  -- type of headers http requests
  type THeaders is table of varchar2(2000) INDEX by varchar2(100);
  -- dummy var
  g_dummy_headers THeaders;

  -- Public function and procedure declarations
  function request(a_adress varchar2,aa_headers THeaders DEFAULT g_dummy_headers, a_msg varchar2 DEFAULT NULL, a_method varchar2 DEFAULT 'GET', a_handle varchar2 DEFAULT null)  return varchar2;

end pk_http;
/

prompt
prompt Creating package PK_LOCK
prompt ========================
prompt
create or replace package freedom.pk_lock is

  -- Author  : RELAXIMUS
  -- Created : 25.12.2013 18:44:23
  -- Purpose : serialization
  
  function lock_and_get_seq(a_seq_name varchar2, a_handle OUT varchar2) return number;
  function release_seq(a_handle varchar2, a_req varchar2) return varchar2;
  procedure release_seq(a_handle varchar2) ;

end pk_lock;
/

prompt
prompt Creating package PK_RISK_ARBITRAGE
prompt ==================================
prompt
create or replace package freedom.pk_risk_arbitrage is

  -- Author  : RELAXIMUS
  -- Created : 16.01.2014 18:13:22
  -- Purpose : implementation of risky kind of arbitrage
  
  procedure  process_deals(a_id_load number);
  
end pk_risk_arbitrage;
/

prompt
prompt Creating procedure P
prompt ====================
prompt
create or replace procedure freedom.p(s varchar2)
is
begin
  dbms_output.put_line(s);
  end;
/

prompt
prompt Creating procedure SHOW_HTML_FROM_URL
prompt =====================================
prompt
CREATE OR REPLACE PROCEDURE FREEDOM.show_html_from_url (p_url  IN  VARCHAR2) AS
  l_http_request   UTL_HTTP.req;
  l_http_response  UTL_HTTP.resp;
  l_text           VARCHAR2(32767);
BEGIN
  -- Make a HTTP request and get the response.
  l_http_request  := UTL_HTTP.begin_request(p_url);
  l_http_response := UTL_HTTP.get_response(l_http_request);

  -- Loop through the response.
  BEGIN
    LOOP
      UTL_HTTP.read_text(l_http_response, l_text, 32766);
      DBMS_OUTPUT.put_line (l_text);
    END LOOP;
  EXCEPTION
    WHEN UTL_HTTP.end_of_body THEN
      UTL_HTTP.end_response(l_http_response);
  END;
EXCEPTION
  WHEN OTHERS THEN
    UTL_HTTP.end_response(l_http_response);
    RAISE;
END show_html_from_url;
/

prompt
prompt Creating package body JSON_AC
prompt =============================
prompt
create or replace package body freedom.json_ac as
  procedure object_remove(p_self in out nocopy json, pair_name varchar2) as
  begin p_self.remove(pair_name); end;
  procedure object_put(p_self in out nocopy json, pair_name varchar2, pair_value json_value, position pls_integer default null) as
  begin p_self.put(pair_name, pair_value, position); end;
  procedure object_put(p_self in out nocopy json, pair_name varchar2, pair_value varchar2, position pls_integer default null) as
  begin p_self.put(pair_name, pair_value, position); end;
  procedure object_put(p_self in out nocopy json, pair_name varchar2, pair_value number, position pls_integer default null) as
  begin p_self.put(pair_name, pair_value, position); end;
  procedure object_put(p_self in out nocopy json, pair_name varchar2, pair_value boolean, position pls_integer default null) as
  begin p_self.put(pair_name, pair_value, position); end;
  procedure object_check_duplicate(p_self in out nocopy json, v_set boolean) as
  begin p_self.check_duplicate(v_set); end;
  procedure object_remove_duplicates(p_self in out nocopy json) as
  begin p_self.remove_duplicates; end;

  procedure object_put(p_self in out nocopy json, pair_name varchar2, pair_value json, position pls_integer default null) as
  begin p_self.put(pair_name, pair_value, position); end;
  procedure object_put(p_self in out nocopy json, pair_name varchar2, pair_value json_list, position pls_integer default null) as
  begin p_self.put(pair_name, pair_value, position); end;

  function object_count(p_self in json) return number as
  begin return p_self.count; end;
  function object_get(p_self in json, pair_name varchar2) return json_value as
  begin return p_self.get(pair_name); end;
  function object_get(p_self in json, position pls_integer) return json_value as
  begin return p_self.get(position); end;
  function object_index_of(p_self in json, pair_name varchar2) return number as
  begin return p_self.index_of(pair_name); end;
  function object_exist(p_self in json, pair_name varchar2) return boolean as
  begin return p_self.exist(pair_name); end;

  function object_to_char(p_self in json, spaces boolean default true, chars_per_line number default 0) return varchar2 as
  begin return p_self.to_char(spaces, chars_per_line); end;
  procedure object_to_clob(p_self in json, buf in out nocopy clob, spaces boolean default false, chars_per_line number default 0, erase_clob boolean default true) as
  begin p_self.to_clob(buf, spaces, chars_per_line, erase_clob); end;
  procedure object_print(p_self in json, spaces boolean default true, chars_per_line number default 8192, jsonp varchar2 default null) as
  begin p_self.print(spaces, chars_per_line, jsonp); end;
  procedure object_htp(p_self in json, spaces boolean default false, chars_per_line number default 0, jsonp varchar2 default null) as
  begin p_self.htp(spaces, chars_per_line, jsonp); end;

  function object_to_json_value(p_self in json) return json_value as
  begin return p_self.to_json_value; end;
  function object_path(p_self in json, json_path varchar2, base number default 1) return json_value as
  begin return p_self.path(json_path, base); end;

  procedure object_path_put(p_self in out nocopy json, json_path varchar2, elem json_value, base number default 1) as
  begin p_self.path_put(json_path, elem, base); end;
  procedure object_path_put(p_self in out nocopy json, json_path varchar2, elem varchar2  , base number default 1) as
  begin p_self.path_put(json_path, elem, base); end;
  procedure object_path_put(p_self in out nocopy json, json_path varchar2, elem number    , base number default 1) as
  begin p_self.path_put(json_path, elem, base); end;
  procedure object_path_put(p_self in out nocopy json, json_path varchar2, elem boolean   , base number default 1) as
  begin p_self.path_put(json_path, elem, base); end;
  procedure object_path_put(p_self in out nocopy json, json_path varchar2, elem json_list , base number default 1) as
  begin p_self.path_put(json_path, elem, base); end;
  procedure object_path_put(p_self in out nocopy json, json_path varchar2, elem json      , base number default 1) as
  begin p_self.path_put(json_path, elem, base); end;

  procedure object_path_remove(p_self in out nocopy json, json_path varchar2, base number default 1) as
  begin p_self.path_remove(json_path, base); end;

  function object_get_values(p_self in json) return json_list as
  begin return p_self.get_values; end;
  function object_get_keys(p_self in json) return json_list as
  begin return p_self.get_keys; end;

  --json_list type
  procedure array_append(p_self in out nocopy json_list, elem json_value, position pls_integer default null) as
  begin p_self.append(elem, position); end;
  procedure array_append(p_self in out nocopy json_list, elem varchar2, position pls_integer default null) as
  begin p_self.append(elem, position); end;
  procedure array_append(p_self in out nocopy json_list, elem number, position pls_integer default null) as
  begin p_self.append(elem, position); end;
  procedure array_append(p_self in out nocopy json_list, elem boolean, position pls_integer default null) as
  begin p_self.append(elem, position); end;
  procedure array_append(p_self in out nocopy json_list, elem json_list, position pls_integer default null) as
  begin p_self.append(elem, position); end;

  procedure array_replace(p_self in out nocopy json_list, position pls_integer, elem json_value) as
  begin p_self.replace(position, elem); end;
  procedure array_replace(p_self in out nocopy json_list, position pls_integer, elem varchar2) as
  begin p_self.replace(position, elem); end;
  procedure array_replace(p_self in out nocopy json_list, position pls_integer, elem number) as
  begin p_self.replace(position, elem); end;
  procedure array_replace(p_self in out nocopy json_list, position pls_integer, elem boolean) as
  begin p_self.replace(position, elem); end;
  procedure array_replace(p_self in out nocopy json_list, position pls_integer, elem json_list) as
  begin p_self.replace(position, elem); end;

  function array_count(p_self in json_list) return number as
  begin return p_self.count; end;
  procedure array_remove(p_self in out nocopy json_list, position pls_integer) as
  begin p_self.remove(position); end;
  procedure array_remove_first(p_self in out nocopy json_list) as
  begin p_self.remove_first; end;
  procedure array_remove_last(p_self in out nocopy json_list) as
  begin p_self.remove_last; end;
  function array_get(p_self in json_list, position pls_integer) return json_value as
  begin return p_self.get(position); end;
  function array_head(p_self in json_list) return json_value as
  begin return p_self.head; end;
  function array_last(p_self in json_list) return json_value as
  begin return p_self.last; end;
  function array_tail(p_self in json_list) return json_list as
  begin return p_self.tail; end;

  function array_to_char(p_self in json_list, spaces boolean default true, chars_per_line number default 0) return varchar2 as
  begin return p_self.to_char(spaces, chars_per_line); end;
  procedure array_to_clob(p_self in json_list, buf in out nocopy clob, spaces boolean default false, chars_per_line number default 0, erase_clob boolean default true) as
  begin p_self.to_clob(buf, spaces, chars_per_line, erase_clob); end;
  procedure array_print(p_self in json_list, spaces boolean default true, chars_per_line number default 8192, jsonp varchar2 default null) as
  begin p_self.print(spaces, chars_per_line, jsonp); end;
  procedure array_htp(p_self in json_list, spaces boolean default false, chars_per_line number default 0, jsonp varchar2 default null) as
  begin p_self.htp(spaces, chars_per_line, jsonp); end;

  function array_path(p_self in json_list, json_path varchar2, base number default 1) return json_value as
  begin return p_self.path(json_path, base); end;
  procedure array_path_put(p_self in out nocopy json_list, json_path varchar2, elem json_value, base number default 1) as
  begin p_self.path_put(json_path, elem, base); end;
  procedure array_path_put(p_self in out nocopy json_list, json_path varchar2, elem varchar2  , base number default 1) as
  begin p_self.path_put(json_path, elem, base); end;
  procedure array_path_put(p_self in out nocopy json_list, json_path varchar2, elem number    , base number default 1) as
  begin p_self.path_put(json_path, elem, base); end;
  procedure array_path_put(p_self in out nocopy json_list, json_path varchar2, elem boolean   , base number default 1) as
  begin p_self.path_put(json_path, elem, base); end;
  procedure array_path_put(p_self in out nocopy json_list, json_path varchar2, elem json_list , base number default 1) as
  begin p_self.path_put(json_path, elem, base); end;

  procedure array_path_remove(p_self in out nocopy json_list, json_path varchar2, base number default 1) as
  begin p_self.path_remove(json_path, base); end;

  function array_to_json_value(p_self in json_list) return json_value as
  begin return p_self.to_json_value; end;

  --json_value


  function jv_get_type(p_self in json_value) return varchar2 as
  begin return p_self.get_type; end;
  function jv_get_string(p_self in json_value, max_byte_size number default null, max_char_size number default null) return varchar2 as
  begin return p_self.get_string(max_byte_size, max_char_size); end;
  procedure jv_get_string(p_self in json_value, buf in out nocopy clob) as
  begin p_self.get_string(buf); end;
  function jv_get_number(p_self in json_value) return number as
  begin return p_self.get_number; end;
  function jv_get_bool(p_self in json_value) return boolean as
  begin return p_self.get_bool; end;
  function jv_get_null(p_self in json_value) return varchar2 as
  begin return p_self.get_null; end;

  function jv_is_object(p_self in json_value) return boolean as
  begin return p_self.is_object; end;
  function jv_is_array(p_self in json_value) return boolean as
  begin return p_self.is_array; end;
  function jv_is_string(p_self in json_value) return boolean as
  begin return p_self.is_string; end;
  function jv_is_number(p_self in json_value) return boolean as
  begin return p_self.is_number; end;
  function jv_is_bool(p_self in json_value) return boolean as
  begin return p_self.is_bool; end;
  function jv_is_null(p_self in json_value) return boolean as
  begin return p_self.is_null; end;

  function jv_to_char(p_self in json_value, spaces boolean default true, chars_per_line number default 0) return varchar2 as
  begin return p_self.to_char(spaces, chars_per_line); end;
  procedure jv_to_clob(p_self in json_value, buf in out nocopy clob, spaces boolean default false, chars_per_line number default 0, erase_clob boolean default true) as
  begin p_self.to_clob(buf, spaces, chars_per_line, erase_clob); end;
  procedure jv_print(p_self in json_value, spaces boolean default true, chars_per_line number default 8192, jsonp varchar2 default null) as
  begin p_self.print(spaces, chars_per_line, jsonp); end;
  procedure jv_htp(p_self in json_value, spaces boolean default false, chars_per_line number default 0, jsonp varchar2 default null) as
  begin p_self.htp(spaces, chars_per_line, jsonp); end;

  function jv_value_of(p_self in json_value, max_byte_size number default null, max_char_size number default null) return varchar2 as
  begin return p_self.value_of(max_byte_size, max_char_size); end;

end json_ac;
/

prompt
prompt Creating package body JSON_DYN
prompt ==============================
prompt
create or replace package body freedom.json_dyn as
/*
  -- 11gR2
  function executeList(stmt in out sys_refcursor) return json_list as
    l_cur number;
  begin
    l_cur := dbms_sql.to_cursor_number(stmt);
    return json_dyn.executeList(null, null, l_cur);
  end;

  -- 11gR2
  function executeObject(stmt in out sys_refcursor) return json as
    l_cur number;
  begin
    l_cur := dbms_sql.to_cursor_number(stmt);
    return json_dyn.executeObject(null, null, l_cur);
  end;
*/

  procedure bind_json(l_cur number, bindvar json) as
    keylist json_list := bindvar.get_keys();
  begin
    for i in 1 .. keylist.count loop
      if(bindvar.get(i).get_type = 'number') then
        dbms_sql.bind_variable(l_cur, ':'||keylist.get(i).get_string, bindvar.get(i).get_number);
      elsif(bindvar.get(i).get_type = 'array') then
        declare
          v_bind dbms_sql.varchar2_table;
          v_arr  json_list := json_list(bindvar.get(i));
        begin
          for j in 1 .. v_arr.count loop
            v_bind(j) := v_arr.get(j).value_of;
          end loop;
          dbms_sql.bind_array(l_cur, ':'||keylist.get(i).get_string, v_bind);
        end;
      else
        dbms_sql.bind_variable(l_cur, ':'||keylist.get(i).get_string, bindvar.get(i).value_of());
      end if;
    end loop;
  end bind_json;

  /* list with objects */
  function executeList(stmt varchar2, bindvar json, cur_num number) return json_list as
    l_cur number;
    l_dtbl dbms_sql.desc_tab;
    l_cnt number;
    l_status number;
    l_val varchar2(4000);
    outer_list json_list := json_list();
    inner_obj json;
    conv number;
    read_date date;
    read_clob clob;
    read_blob blob;
    col_type number;
  begin
    if(cur_num is not null) then
      l_cur := cur_num;
    else
      l_cur := dbms_sql.open_cursor;
      dbms_sql.parse(l_cur, stmt, dbms_sql.native);
      if(bindvar is not null) then bind_json(l_cur, bindvar); end if;
    end if;
    dbms_sql.describe_columns(l_cur, l_cnt, l_dtbl);
    for i in 1..l_cnt loop
      col_type := l_dtbl(i).col_type;
      --dbms_output.put_line(col_type);
      if(col_type = 12) then
        dbms_sql.define_column(l_cur,i,read_date);
      elsif(col_type = 112) then
        dbms_sql.define_column(l_cur,i,read_clob);
      elsif(col_type = 113) then
        dbms_sql.define_column(l_cur,i,read_blob);
      elsif(col_type in (1,2,96)) then
        dbms_sql.define_column(l_cur,i,l_val,4000);
      end if;
    end loop;

    if(cur_num is null) then l_status := dbms_sql.execute(l_cur); end if;

    --loop through rows
    while ( dbms_sql.fetch_rows(l_cur) > 0 ) loop
      inner_obj := json(); --init for each row
      --loop through columns
      for i in 1..l_cnt loop
        case true
        --handling string types
        when l_dtbl(i).col_type in (1,96) then -- varchar2
          dbms_sql.column_value(l_cur,i,l_val);
          if(l_val is null) then
            if(null_as_empty_string) then
              inner_obj.put(l_dtbl(i).col_name, ''); --treatet as emptystring?
            else
              inner_obj.put(l_dtbl(i).col_name, json_value.makenull); --null
            end if;
          else
            inner_obj.put(l_dtbl(i).col_name, json_value(l_val)); --null
          end if;
          --dbms_output.put_line(l_dtbl(i).col_name||' --> '||l_val||'varchar2' ||l_dtbl(i).col_type);
        --handling number types
        when l_dtbl(i).col_type = 2 then -- number
          dbms_sql.column_value(l_cur,i,l_val);
          conv := l_val;
          inner_obj.put(l_dtbl(i).col_name, conv);
          -- dbms_output.put_line(l_dtbl(i).col_name||' --> '||l_val||'number ' ||l_dtbl(i).col_type);
        when l_dtbl(i).col_type = 12 then -- date
          if(include_dates) then
            dbms_sql.column_value(l_cur,i,read_date);
            inner_obj.put(l_dtbl(i).col_name, json_ext.to_json_value(read_date));
          end if;
          --dbms_output.put_line(l_dtbl(i).col_name||' --> '||l_val||'date ' ||l_dtbl(i).col_type);
        when l_dtbl(i).col_type = 112 then --clob
          if(include_clobs) then
            dbms_sql.column_value(l_cur,i,read_clob);
            inner_obj.put(l_dtbl(i).col_name, json_value(read_clob));
          end if;
        when l_dtbl(i).col_type = 113 then --blob
          if(include_blobs) then
            dbms_sql.column_value(l_cur,i,read_blob);
            if(dbms_lob.getlength(read_blob) > 0) then
              inner_obj.put(l_dtbl(i).col_name, json_ext.encode(read_blob));
            else
              inner_obj.put(l_dtbl(i).col_name, json_value.makenull);
            end if;
          end if;

        else null; --discard other types
        end case;
      end loop;
      outer_list.append(inner_obj.to_json_value);
    end loop;
    dbms_sql.close_cursor(l_cur);
    return outer_list;
  end executeList;

  /* object with lists */
  function executeObject(stmt varchar2, bindvar json, cur_num number) return json as
    l_cur number;
    l_dtbl dbms_sql.desc_tab;
    l_cnt number;
    l_status number;
    l_val varchar2(4000);
    inner_list_names json_list := json_list();
    inner_list_data json_list := json_list();
    data_list json_list;
    outer_obj json := json();
    conv number;
    read_date date;
    read_clob clob;
    read_blob blob;
    col_type number;
  begin
    if(cur_num is not null) then
      l_cur := cur_num;
    else
      l_cur := dbms_sql.open_cursor;
      dbms_sql.parse(l_cur, stmt, dbms_sql.native);
      if(bindvar is not null) then bind_json(l_cur, bindvar); end if;
    end if;
    dbms_sql.describe_columns(l_cur, l_cnt, l_dtbl);
    for i in 1..l_cnt loop
      col_type := l_dtbl(i).col_type;
      if(col_type = 12) then
        dbms_sql.define_column(l_cur,i,read_date);
      elsif(col_type = 112) then
        dbms_sql.define_column(l_cur,i,read_clob);
      elsif(col_type = 113) then
        dbms_sql.define_column(l_cur,i,read_blob);
      elsif(col_type in (1,2,96)) then
        dbms_sql.define_column(l_cur,i,l_val,4000);
      end if;
    end loop;
    if(cur_num is null) then l_status := dbms_sql.execute(l_cur); end if;

    --build up name_list
    for i in 1..l_cnt loop
      case l_dtbl(i).col_type
        when 1 then inner_list_names.append(l_dtbl(i).col_name);
        when 96 then inner_list_names.append(l_dtbl(i).col_name);
        when 2 then inner_list_names.append(l_dtbl(i).col_name);
        when 12 then if(include_dates) then inner_list_names.append(l_dtbl(i).col_name); end if;
        when 112 then if(include_clobs) then inner_list_names.append(l_dtbl(i).col_name); end if;
        when 113 then if(include_blobs) then inner_list_names.append(l_dtbl(i).col_name); end if;
        else null;
      end case;
    end loop;

    --loop through rows
    while ( dbms_sql.fetch_rows(l_cur) > 0 ) loop
      data_list := json_list();
      --loop through columns
      for i in 1..l_cnt loop
        case true
        --handling string types
        when l_dtbl(i).col_type in (1,96) then -- varchar2
          dbms_sql.column_value(l_cur,i,l_val);
          if(l_val is null) then
            if(null_as_empty_string) then
              data_list.append(''); --treatet as emptystring?
            else
              data_list.append(json_value.makenull); --null
            end if;
          else
            data_list.append(json_value(l_val)); --null
          end if;
          --dbms_output.put_line(l_dtbl(i).col_name||' --> '||l_val||'varchar2' ||l_dtbl(i).col_type);
        --handling number types
        when l_dtbl(i).col_type = 2 then -- number
          dbms_sql.column_value(l_cur,i,l_val);
          conv := l_val;
          data_list.append(conv);
          -- dbms_output.put_line(l_dtbl(i).col_name||' --> '||l_val||'number ' ||l_dtbl(i).col_type);
        when l_dtbl(i).col_type = 12 then -- date
          if(include_dates) then
            dbms_sql.column_value(l_cur,i,read_date);
            data_list.append(json_ext.to_json_value(read_date));
          end if;
          --dbms_output.put_line(l_dtbl(i).col_name||' --> '||l_val||'date ' ||l_dtbl(i).col_type);
        when l_dtbl(i).col_type = 112 then --clob
          if(include_clobs) then
            dbms_sql.column_value(l_cur,i,read_clob);
            data_list.append(json_value(read_clob));
          end if;
        when l_dtbl(i).col_type = 113 then --blob
          if(include_blobs) then
            dbms_sql.column_value(l_cur,i,read_blob);
            if(dbms_lob.getlength(read_blob) > 0) then
              data_list.append(json_ext.encode(read_blob));
            else
              data_list.append(json_value.makenull);
            end if;
          end if;
        else null; --discard other types
        end case;
      end loop;
      inner_list_data.append(data_list);
    end loop;

    outer_obj.put('names', inner_list_names.to_json_value);
    outer_obj.put('data', inner_list_data.to_json_value);
    dbms_sql.close_cursor(l_cur);
    return outer_obj;
  end executeObject;

end json_dyn;
/

prompt
prompt Creating package body JSON_EXT
prompt ==============================
prompt
create or replace package body freedom.json_ext as
  scanner_exception exception;
  pragma exception_init(scanner_exception, -20100);
  parser_exception exception;
  pragma exception_init(parser_exception, -20101);
  jext_exception exception;
  pragma exception_init(jext_exception, -20110);

  --extra function checks if number has no fraction
  function is_integer(v json_value) return boolean as
    myint number(38); --the oracle way to specify an integer
  begin
    if(v.is_number) then
      myint := v.get_number;
      return (myint = v.get_number); --no rounding errors?
    else
      return false;
    end if;
  end;

  --extension enables json to store dates without comprimising the implementation
  function to_json_value(d date) return json_value as
  begin
    return json_value(to_char(d, format_string));
  end;

  --notice that a date type in json is also a varchar2
  function is_date(v json_value) return boolean as
    temp date;
  begin
    temp := json_ext.to_date2(v);
    return true;
  exception
    when others then
      return false;
  end;

  --convertion is needed to extract dates
  function to_date2(v json_value) return date as
  begin
    if(v.is_string) then
      return to_date(v.get_string, format_string);
    else
      raise_application_error(-20110, 'Anydata did not contain a date-value');
    end if;
  exception
    when others then
      raise_application_error(-20110, 'Anydata did not contain a date on the format: '||format_string);
  end;

  --Json Path parser
  function parsePath(json_path varchar2, base number default 1) return json_list as
    build_path varchar2(32767) := '[';
    buf varchar2(4);
    endstring varchar2(1);
    indx number := 1;
    ret json_list;

    procedure next_char as
    begin
      if(indx <= length(json_path)) then
        buf := substr(json_path, indx, 1);
        indx := indx + 1;
      else
        buf := null;
      end if;
    end;
    --skip ws
    procedure skipws as begin while(buf in (chr(9),chr(10),chr(13),' ')) loop next_char; end loop; end;

  begin
    next_char();
    while(buf is not null) loop
      if(buf = '.') then
        next_char();
        if(buf is null) then raise_application_error(-20110, 'JSON Path parse error: . is not a valid json_path end'); end if;
        if(not regexp_like(buf, '^[[:alnum:]\_ ]+', 'c') ) then
          raise_application_error(-20110, 'JSON Path parse error: alpha-numeric character or space expected at position '||indx);
        end if;

        if(build_path != '[') then build_path := build_path || ','; end if;
        build_path := build_path || '"';
        while(regexp_like(buf, '^[[:alnum:]\_ ]+', 'c') ) loop
          build_path := build_path || buf;
          next_char();
        end loop;
        build_path := build_path || '"';
      elsif(buf = '[') then
        next_char();
        skipws();
        if(buf is null) then raise_application_error(-20110, 'JSON Path parse error: [ is not a valid json_path end'); end if;
        if(buf in ('1','2','3','4','5','6','7','8','9') or (buf = '0' and base = 0)) then
          if(build_path != '[') then build_path := build_path || ','; end if;
          while(buf in ('0','1','2','3','4','5','6','7','8','9')) loop
            build_path := build_path || buf;
            next_char();
          end loop;
        elsif (regexp_like(buf, '^(\"|\'')', 'c')) then
          endstring := buf;
          if(build_path != '[') then build_path := build_path || ','; end if;
          build_path := build_path || '"';
          next_char();
          if(buf is null) then raise_application_error(-20110, 'JSON Path parse error: premature json_path end'); end if;
          while(buf != endstring) loop
            build_path := build_path || buf;
            next_char();
            if(buf is null) then raise_application_error(-20110, 'JSON Path parse error: premature json_path end'); end if;
            if(buf = '\') then
              next_char();
              build_path := build_path || '\' || buf;
              next_char();
            end if;
          end loop;
          build_path := build_path || '"';
          next_char();
        else
          raise_application_error(-20110, 'JSON Path parse error: expected a string or an positive integer at '||indx);
        end if;
        skipws();
        if(buf is null) then raise_application_error(-20110, 'JSON Path parse error: premature json_path end'); end if;
        if(buf != ']') then raise_application_error(-20110, 'JSON Path parse error: no array ending found. found: '|| buf); end if;
        next_char();
        skipws();
      elsif(build_path = '[') then
        if(not regexp_like(buf, '^[[:alnum:]\_ ]+', 'c') ) then
          raise_application_error(-20110, 'JSON Path parse error: alpha-numeric character or space expected at position '||indx);
        end if;
        build_path := build_path || '"';
        while(regexp_like(buf, '^[[:alnum:]\_ ]+', 'c') ) loop
          build_path := build_path || buf;
          next_char();
        end loop;
        build_path := build_path || '"';
      else
        raise_application_error(-20110, 'JSON Path parse error: expected . or [ found '|| buf || ' at position '|| indx);
      end if;

    end loop;

    build_path := build_path || ']';
    build_path := replace(replace(replace(replace(replace(build_path, chr(9), '\t'), chr(10), '\n'), chr(13), '\f'), chr(8), '\b'), chr(14), '\r');

    ret := json_list(build_path);
    if(base != 1) then
      --fix base 0 to base 1
      declare
        elem json_value;
      begin
        for i in 1 .. ret.count loop
          elem := ret.get(i);
          if(elem.is_number) then
            ret.replace(i,elem.get_number()+1);
          end if;
        end loop;
      end;
    end if;

    return ret;
  end parsePath;

  --JSON Path getters
  function get_json_value(obj json, v_path varchar2, base number default 1) return json_value as
    path json_list;
    ret json_value;
    o json; l json_list;
  begin
    path := parsePath(v_path, base);
    ret := obj.to_json_value;
    if(path.count = 0) then return ret; end if;

    for i in 1 .. path.count loop
      if(path.get(i).is_string()) then
        --string fetch only on json
        o := json(ret);
        ret := o.get(path.get(i).get_string());
      else
        --number fetch on json and json_list
        if(ret.is_array()) then
          l := json_list(ret);
          ret := l.get(path.get(i).get_number());
        else
          o := json(ret);
          l := o.get_values();
          ret := l.get(path.get(i).get_number());
        end if;
      end if;
    end loop;

    return ret;
  exception
    when scanner_exception then raise;
    when parser_exception then raise;
    when jext_exception then raise;
    when others then return null;
  end get_json_value;

  --JSON Path getters
  function get_string(obj json, path varchar2, base number default 1) return varchar2 as
    temp json_value;
  begin
    temp := get_json_value(obj, path, base);
    if(temp is null or not temp.is_string) then
      return null;
    else
      return temp.get_string;
    end if;
  end;

  function get_number(obj json, path varchar2, base number default 1) return number as
    temp json_value;
  begin
    temp := get_json_value(obj, path, base);
    if(temp is null or not temp.is_number) then
      return null;
    else
      return temp.get_number;
    end if;
  end;

  function get_json(obj json, path varchar2, base number default 1) return json as
    temp json_value;
  begin
    temp := get_json_value(obj, path, base);
    if(temp is null or not temp.is_object) then
      return null;
    else
      return json(temp);
    end if;
  end;

  function get_json_list(obj json, path varchar2, base number default 1) return json_list as
    temp json_value;
  begin
    temp := get_json_value(obj, path, base);
    if(temp is null or not temp.is_array) then
      return null;
    else
      return json_list(temp);
    end if;
  end;

  function get_bool(obj json, path varchar2, base number default 1) return boolean as
    temp json_value;
  begin
    temp := get_json_value(obj, path, base);
    if(temp is null or not temp.is_bool) then
      return null;
    else
      return temp.get_bool;
    end if;
  end;

  function get_date(obj json, path varchar2, base number default 1) return date as
    temp json_value;
  begin
    temp := get_json_value(obj, path, base);
    if(temp is null or not is_date(temp)) then
      return null;
    else
      return json_ext.to_date2(temp);
    end if;
  end;

  /* JSON Path putter internal function */
  procedure put_internal(obj in out nocopy json, v_path varchar2, elem json_value, base number) as
    val json_value := elem;
    path json_list;
    backreference json_list := json_list();

    keyval json_value; keynum number; keystring varchar2(4000);
    temp json_value := obj.to_json_value;
    obj_temp  json;
    list_temp json_list;
    inserter json_value;
  begin
    path := json_ext.parsePath(v_path, base);
    if(path.count = 0) then raise_application_error(-20110, 'JSON_EXT put error: cannot put with empty string.'); end if;

    --build backreference
    for i in 1 .. path.count loop
      --backreference.print(false);
      keyval := path.get(i);
      if (keyval.is_number()) then
        --nummer index
        keynum := keyval.get_number();
        if((not temp.is_object()) and (not temp.is_array())) then
          if(val is null) then return; end if;
          backreference.remove_last;
          temp := json_list().to_json_value();
          backreference.append(temp);
        end if;

        if(temp.is_object()) then
          obj_temp := json(temp);
          if(obj_temp.count < keynum) then
            if(val is null) then return; end if;
            raise_application_error(-20110, 'JSON_EXT put error: access object with to few members.');
          end if;
          temp := obj_temp.get(keynum);
        else
          list_temp := json_list(temp);
          if(list_temp.count < keynum) then
            if(val is null) then return; end if;
            --raise error or quit if val is null
            for i in list_temp.count+1 .. keynum loop
              list_temp.append(json_value.makenull);
            end loop;
            backreference.remove_last;
            backreference.append(list_temp);
          end if;

          temp := list_temp.get(keynum);
        end if;
      else
        --streng index
        keystring := keyval.get_string();
        if(not temp.is_object()) then
          --backreference.print;
          if(val is null) then return; end if;
          backreference.remove_last;
          temp := json().to_json_value();
          backreference.append(temp);
          --raise_application_error(-20110, 'JSON_ext put error: trying to access a non object with a string.');
        end if;
        obj_temp := json(temp);
        temp := obj_temp.get(keystring);
      end if;

      if(temp is null) then
        if(val is null) then return; end if;
        --what to expect?
        keyval := path.get(i+1);
        if(keyval is not null and keyval.is_number()) then
          temp := json_list().to_json_value;
        else
          temp := json().to_json_value;
        end if;
      end if;
      backreference.append(temp);
    end loop;

  --  backreference.print(false);
  --  path.print(false);

    --use backreference and path together
    inserter := val;
    for i in reverse 1 .. backreference.count loop
  --    inserter.print(false);
      if( i = 1 ) then
        keyval := path.get(1);
        if(keyval.is_string()) then
          keystring := keyval.get_string();
        else
          keynum := keyval.get_number();
          declare
            t1 json_value := obj.get(keynum);
          begin
            keystring := t1.mapname;
          end;
        end if;
        if(inserter is null) then obj.remove(keystring); else obj.put(keystring, inserter); end if;
      else
        temp := backreference.get(i-1);
        if(temp.is_object()) then
          keyval := path.get(i);
          obj_temp := json(temp);
          if(keyval.is_string()) then
            keystring := keyval.get_string();
          else
            keynum := keyval.get_number();
            declare
              t1 json_value := obj_temp.get(keynum);
            begin
              keystring := t1.mapname;
            end;
          end if;
          if(inserter is null) then
            obj_temp.remove(keystring);
            if(obj_temp.count > 0) then inserter := obj_temp.to_json_value; end if;
          else
            obj_temp.put(keystring, inserter);
            inserter := obj_temp.to_json_value;
          end if;
        else
          --array only number
          keynum := path.get(i).get_number();
          list_temp := json_list(temp);
          list_temp.remove(keynum);
          if(not inserter is null) then
            list_temp.append(inserter, keynum);
            inserter := list_temp.to_json_value;
          else
            if(list_temp.count > 0) then inserter := list_temp.to_json_value; end if;
          end if;
        end if;
      end if;

    end loop;

  end put_internal;

  /* JSON Path putters */
  procedure put(obj in out nocopy json, path varchar2, elem varchar2, base number default 1) as
  begin
    put_internal(obj, path, json_value(elem), base);
  end;

  procedure put(obj in out nocopy json, path varchar2, elem number, base number default 1) as
  begin
    if(elem is null) then raise_application_error(-20110, 'Cannot put null-value'); end if;
    put_internal(obj, path, json_value(elem), base);
  end;

  procedure put(obj in out nocopy json, path varchar2, elem json, base number default 1) as
  begin
    if(elem is null) then raise_application_error(-20110, 'Cannot put null-value'); end if;
    put_internal(obj, path, elem.to_json_value, base);
  end;

  procedure put(obj in out nocopy json, path varchar2, elem json_list, base number default 1) as
  begin
    if(elem is null) then raise_application_error(-20110, 'Cannot put null-value'); end if;
    put_internal(obj, path, elem.to_json_value, base);
  end;

  procedure put(obj in out nocopy json, path varchar2, elem boolean, base number default 1) as
  begin
    if(elem is null) then raise_application_error(-20110, 'Cannot put null-value'); end if;
    put_internal(obj, path, json_value(elem), base);
  end;

  procedure put(obj in out nocopy json, path varchar2, elem json_value, base number default 1) as
  begin
    if(elem is null) then raise_application_error(-20110, 'Cannot put null-value'); end if;
    put_internal(obj, path, elem, base);
  end;

  procedure put(obj in out nocopy json, path varchar2, elem date, base number default 1) as
  begin
    if(elem is null) then raise_application_error(-20110, 'Cannot put null-value'); end if;
    put_internal(obj, path, json_ext.to_json_value(elem), base);
  end;

  procedure remove(obj in out nocopy json, path varchar2, base number default 1) as
  begin
    json_ext.put_internal(obj,path,null,base);
--    if(json_ext.get_json_value(obj,path) is not null) then
--    end if;
  end remove;

    --Pretty print with JSON Path
  function pp(obj json, v_path varchar2) return varchar2 as
    json_part json_value;
  begin
    json_part := json_ext.get_json_value(obj, v_path);
    if(json_part is null) then
      return '';
    else
      return json_printer.pretty_print_any(json_part); --escapes a possible internal string
    end if;
  end pp;

  procedure pp(obj json, v_path varchar2) as --using dbms_output.put_line
  begin
    dbms_output.put_line(pp(obj, v_path));
  end pp;

  -- spaces = false!
  procedure pp_htp(obj json, v_path varchar2) as --using htp.print
    json_part json_value;
  begin
    json_part := json_ext.get_json_value(obj, v_path);
    if(json_part is null) then htp.print; else
      htp.print(json_printer.pretty_print_any(json_part, false));
    end if;
  end pp_htp;

  function base64(binarydata blob) return json_list as
    obj json_list := json_list();
    c clob := empty_clob();
    benc blob;

    v_blob_offset NUMBER := 1;
    v_clob_offset NUMBER := 1;
    v_lang_context NUMBER := DBMS_LOB.DEFAULT_LANG_CTX;
    v_warning NUMBER;
    v_amount PLS_INTEGER;
--    temp varchar2(32767);

    FUNCTION encodeBlob2Base64(pBlobIn IN BLOB) RETURN BLOB IS
      vAmount NUMBER := 45;
      vBlobEnc BLOB := empty_blob();
      vBlobEncLen NUMBER := 0;
      vBlobInLen NUMBER := 0;
      vBuffer RAW(45);
      vOffset NUMBER := 1;
    BEGIN
--      dbms_output.put_line('Start base64 encoding.');
      vBlobInLen := dbms_lob.getlength(pBlobIn);
--      dbms_output.put_line('<BlobInLength>' || vBlobInLen);
      dbms_lob.createtemporary(vBlobEnc, TRUE);
      LOOP
        IF vOffset >= vBlobInLen THEN
          EXIT;
        END IF;
        dbms_lob.read(pBlobIn, vAmount, vOffset, vBuffer);
        BEGIN
          dbms_lob.append(vBlobEnc, utl_encode.base64_encode(vBuffer));
        EXCEPTION
          WHEN OTHERS THEN
          dbms_output.put_line('<vAmount>' || vAmount || '<vOffset>' || vOffset || '<vBuffer>' || vBuffer);
          dbms_output.put_line('ERROR IN append: ' || SQLERRM);
          RAISE;
        END;
        vOffset := vOffset + vAmount;
      END LOOP;
      vBlobEncLen := dbms_lob.getlength(vBlobEnc);
--      dbms_output.put_line('<BlobEncLength>' || vBlobEncLen);
--      dbms_output.put_line('Finshed base64 encoding.');
      RETURN vBlobEnc;
    END encodeBlob2Base64;
  begin
    benc := encodeBlob2Base64(binarydata);
    dbms_lob.createtemporary(c, TRUE);
    v_amount := DBMS_LOB.GETLENGTH(benc);
    DBMS_LOB.CONVERTTOCLOB(c, benc, v_amount, v_clob_offset, v_blob_offset, 1, v_lang_context, v_warning);

    v_amount := DBMS_LOB.GETLENGTH(c);
    v_clob_offset := 1;
    --dbms_output.put_line('V amount: '||v_amount);
    while(v_clob_offset < v_amount) loop
      --dbms_output.put_line(v_offset);
      --temp := ;
      --dbms_output.put_line('size: '||length(temp));
      obj.append(dbms_lob.SUBSTR(c, 4000,v_clob_offset));
      v_clob_offset := v_clob_offset + 4000;
    end loop;
    dbms_lob.freetemporary(benc);
    dbms_lob.freetemporary(c);
  --dbms_output.put_line(obj.count);
  --dbms_output.put_line(obj.get_last().to_char);
    return obj;

  end base64;


  function base64(l json_list) return blob as
    c clob := empty_clob();
    b blob := empty_blob();
    bret blob;

    v_blob_offset NUMBER := 1;
    v_clob_offset NUMBER := 1;
    v_lang_context NUMBER := 0; --DBMS_LOB.DEFAULT_LANG_CTX;
    v_warning NUMBER;
    v_amount PLS_INTEGER;

    FUNCTION decodeBase642Blob(pBlobIn IN BLOB) RETURN BLOB IS
      vAmount NUMBER := 256;--32;
      vBlobDec BLOB := empty_blob();
      vBlobDecLen NUMBER := 0;
      vBlobInLen NUMBER := 0;
      vBuffer RAW(256);--32);
      vOffset NUMBER := 1;
    BEGIN
--      dbms_output.put_line('Start base64 decoding.');
      vBlobInLen := dbms_lob.getlength(pBlobIn);
--      dbms_output.put_line('<BlobInLength>' || vBlobInLen);
      dbms_lob.createtemporary(vBlobDec, TRUE);
      LOOP
        IF vOffset >= vBlobInLen THEN
          EXIT;
        END IF;
        dbms_lob.read(pBlobIn, vAmount, vOffset, vBuffer);
        BEGIN
          dbms_lob.append(vBlobDec, utl_encode.base64_decode(vBuffer));
        EXCEPTION
          WHEN OTHERS THEN
          dbms_output.put_line('<vAmount>' || vAmount || '<vOffset>' || vOffset || '<vBuffer>' || vBuffer);
          dbms_output.put_line('ERROR IN append: ' || SQLERRM);
          RAISE;
        END;
        vOffset := vOffset + vAmount;
      END LOOP;
      vBlobDecLen := dbms_lob.getlength(vBlobDec);
--      dbms_output.put_line('<BlobDecLength>' || vBlobDecLen);
--      dbms_output.put_line('Finshed base64 decoding.');
      RETURN vBlobDec;
    END decodeBase642Blob;
  begin
    dbms_lob.createtemporary(c, TRUE);
    for i in 1 .. l.count loop
      dbms_lob.append(c, l.get(i).get_string());
    end loop;
    v_amount := DBMS_LOB.GETLENGTH(c);
--    dbms_output.put_line('L C'||v_amount);

    dbms_lob.createtemporary(b, TRUE);
    DBMS_LOB.CONVERTTOBLOB(b, c, dbms_lob.lobmaxsize, v_clob_offset, v_blob_offset, 1, v_lang_context, v_warning);
    dbms_lob.freetemporary(c);
    v_amount := DBMS_LOB.GETLENGTH(b);
--    dbms_output.put_line('L B'||v_amount);

    bret := decodeBase642Blob(b);
    dbms_lob.freetemporary(b);
    return bret;

  end base64;

  function encode(binarydata blob) return json_value as
    obj json_value;
    c clob := empty_clob();
    benc blob;

    v_blob_offset NUMBER := 1;
    v_clob_offset NUMBER := 1;
    v_lang_context NUMBER := DBMS_LOB.DEFAULT_LANG_CTX;
    v_warning NUMBER;
    v_amount PLS_INTEGER;
--    temp varchar2(32767);

    FUNCTION encodeBlob2Base64(pBlobIn IN BLOB) RETURN BLOB IS
      vAmount NUMBER := 45;
      vBlobEnc BLOB := empty_blob();
      vBlobEncLen NUMBER := 0;
      vBlobInLen NUMBER := 0;
      vBuffer RAW(45);
      vOffset NUMBER := 1;
    BEGIN
--      dbms_output.put_line('Start base64 encoding.');
      vBlobInLen := dbms_lob.getlength(pBlobIn);
--      dbms_output.put_line('<BlobInLength>' || vBlobInLen);
      dbms_lob.createtemporary(vBlobEnc, TRUE);
      LOOP
        IF vOffset >= vBlobInLen THEN
          EXIT;
        END IF;
        dbms_lob.read(pBlobIn, vAmount, vOffset, vBuffer);
        BEGIN
          dbms_lob.append(vBlobEnc, utl_encode.base64_encode(vBuffer));
        EXCEPTION
          WHEN OTHERS THEN
          dbms_output.put_line('<vAmount>' || vAmount || '<vOffset>' || vOffset || '<vBuffer>' || vBuffer);
          dbms_output.put_line('ERROR IN append: ' || SQLERRM);
          RAISE;
        END;
        vOffset := vOffset + vAmount;
      END LOOP;
      vBlobEncLen := dbms_lob.getlength(vBlobEnc);
--      dbms_output.put_line('<BlobEncLength>' || vBlobEncLen);
--      dbms_output.put_line('Finshed base64 encoding.');
      RETURN vBlobEnc;
    END encodeBlob2Base64;
  begin
    benc := encodeBlob2Base64(binarydata);
    dbms_lob.createtemporary(c, TRUE);
    v_amount := DBMS_LOB.GETLENGTH(benc);
    DBMS_LOB.CONVERTTOCLOB(c, benc, v_amount, v_clob_offset, v_blob_offset, 1, v_lang_context, v_warning);

    obj := json_value(c);

    dbms_lob.freetemporary(benc);
    dbms_lob.freetemporary(c);
  --dbms_output.put_line(obj.count);
  --dbms_output.put_line(obj.get_last().to_char);
    return obj;

  end encode;

  function decode(v json_value) return blob as
    c clob := empty_clob();
    b blob := empty_blob();
    bret blob;

    v_blob_offset NUMBER := 1;
    v_clob_offset NUMBER := 1;
    v_lang_context NUMBER := 0; --DBMS_LOB.DEFAULT_LANG_CTX;
    v_warning NUMBER;
    v_amount PLS_INTEGER;

    FUNCTION decodeBase642Blob(pBlobIn IN BLOB) RETURN BLOB IS
      vAmount NUMBER := 256;--32;
      vBlobDec BLOB := empty_blob();
      vBlobDecLen NUMBER := 0;
      vBlobInLen NUMBER := 0;
      vBuffer RAW(256);--32);
      vOffset NUMBER := 1;
    BEGIN
--      dbms_output.put_line('Start base64 decoding.');
      vBlobInLen := dbms_lob.getlength(pBlobIn);
--      dbms_output.put_line('<BlobInLength>' || vBlobInLen);
      dbms_lob.createtemporary(vBlobDec, TRUE);
      LOOP
        IF vOffset >= vBlobInLen THEN
          EXIT;
        END IF;
        dbms_lob.read(pBlobIn, vAmount, vOffset, vBuffer);
        BEGIN
          dbms_lob.append(vBlobDec, utl_encode.base64_decode(vBuffer));
        EXCEPTION
          WHEN OTHERS THEN
          dbms_output.put_line('<vAmount>' || vAmount || '<vOffset>' || vOffset || '<vBuffer>' || vBuffer);
          dbms_output.put_line('ERROR IN append: ' || SQLERRM);
          RAISE;
        END;
        vOffset := vOffset + vAmount;
      END LOOP;
      vBlobDecLen := dbms_lob.getlength(vBlobDec);
--      dbms_output.put_line('<BlobDecLength>' || vBlobDecLen);
--      dbms_output.put_line('Finshed base64 decoding.');
      RETURN vBlobDec;
    END decodeBase642Blob;
  begin
    dbms_lob.createtemporary(c, TRUE);
    v.get_string(c);
    v_amount := DBMS_LOB.GETLENGTH(c);
--    dbms_output.put_line('L C'||v_amount);

    dbms_lob.createtemporary(b, TRUE);
    DBMS_LOB.CONVERTTOBLOB(b, c, dbms_lob.lobmaxsize, v_clob_offset, v_blob_offset, 1, v_lang_context, v_warning);
    dbms_lob.freetemporary(c);
    v_amount := DBMS_LOB.GETLENGTH(b);
--    dbms_output.put_line('L B'||v_amount);

    bret := decodeBase642Blob(b);
    dbms_lob.freetemporary(b);
    return bret;

  end decode;


end json_ext;
/

prompt
prompt Creating package body JSON_HELPER
prompt =================================
prompt
create or replace package body freedom.json_helper as

  --recursive merge
  function merge( p_a_json json, p_b_json json) return json as
    l_json    JSON;
    l_jv      json_value;
    l_indx    number;
    l_recursive json_value;
  begin
    --
    -- Initialize our return object
    --
    l_json := p_a_json;

    -- loop through p_b_json
    l_indx := p_b_json.json_data.first;
    loop
      exit when l_indx is null;
      l_jv   := p_b_json.json_data(l_indx);
      if(l_jv.is_object) then
        --recursive
        l_recursive := l_json.get(l_jv.mapname);
        if(l_recursive is not null and l_recursive.is_object) then
          l_json.put(l_jv.mapname, merge(json(l_recursive), json(l_jv)));
        else
          l_json.put(l_jv.mapname, l_jv);
        end if;
      else
        l_json.put(l_jv.mapname, l_jv);
      end if;

      --increment
      l_indx := p_b_json.json_data.next(l_indx);
    end loop;

    return l_json;

  end merge;

  -- join two lists
  function join( p_a_list json_list, p_b_list json_list) return json_list as
    l_json_list json_list := p_a_list;
  begin
    for indx in 1 .. p_b_list.count loop
      l_json_list.append(p_b_list.get(indx));
    end loop;

    return l_json_list;

  end join;

  -- keep keys.
  function keep( p_json json, p_keys json_list) return json as
    l_json json := json();
    mapname varchar2(4000);
  begin
    for i in 1 .. p_keys.count loop
      mapname := p_keys.get(i).get_string;
      if(p_json.exist(mapname)) then
        l_json.put(mapname, p_json.get(mapname));
      end if;
    end loop;

    return l_json;
  end keep;

  -- drop keys.
  function remove( p_json json, p_keys json_list) return json as
    l_json json := p_json;
  begin
    for i in 1 .. p_keys.count loop
      l_json.remove(p_keys.get(i).get_string);
    end loop;

    return l_json;
  end remove;

  --equals functions

  function equals(p_v1 json_value, p_v2 number) return boolean as
  begin
    if(p_v2 is null) then
      return p_v1.is_null;
    end if;

    if(not p_v1.is_number) then
      return false;
    end if;

    return p_v2 = p_v1.get_number;
  end;

  function equals(p_v1 json_value, p_v2 boolean) return boolean as
  begin
    if(p_v2 is null) then
      return p_v1.is_null;
    end if;

    if(not p_v1.is_bool) then
      return false;
    end if;

    return p_v2 = p_v1.get_bool;
  end;

  function equals(p_v1 json_value, p_v2 varchar2) return boolean as
  begin
    if(p_v2 is null) then
      return p_v1.is_null;
    end if;

    if(not p_v1.is_string) then
      return false;
    end if;

    return p_v2 = p_v1.get_string;
  end;

  function equals(p_v1 json_value, p_v2 clob) return boolean as
    my_clob clob;
    res boolean;
  begin
    if(p_v2 is null) then
      return p_v1.is_null;
    end if;

    if(not p_v1.is_string) then
      return false;
    end if;

    my_clob := empty_clob();
    dbms_lob.createtemporary(my_clob, true);
    p_v1.get_string(my_clob);

    res := dbms_lob.compare(p_v2, my_clob) = 0;
    dbms_lob.freetemporary(my_clob);
  end;

  function equals(p_v1 json_value, p_v2 json_value, exact boolean) return boolean as
  begin
    if(p_v2 is null) then
      return p_v1.is_null;
    end if;

    if(p_v2.is_number) then return equals(p_v1, p_v2.get_number); end if;
    if(p_v2.is_bool) then return equals(p_v1, p_v2.get_bool); end if;
    if(p_v2.is_object) then return equals(p_v1, json(p_v2), exact); end if;
    if(p_v2.is_array) then return equals(p_v1, json_list(p_v2), exact); end if;
    if(p_v2.is_string) then
      if(p_v2.extended_str is null) then
        return equals(p_v1, p_v2.get_string);
      else
        declare
          my_clob clob; res boolean;
        begin
          my_clob := empty_clob();
          dbms_lob.createtemporary(my_clob, true);
          p_v2.get_string(my_clob);
          res := equals(p_v1, my_clob);
          dbms_lob.freetemporary(my_clob);
          return res;
        end;
      end if;
    end if;

    return false; --should never happen
  end;

  function equals(p_v1 json_value, p_v2 json_list, exact boolean) return boolean as
    cmp json_list;
    res boolean := true;
  begin
--  p_v1.print(false);
--  p_v2.print(false);
--  dbms_output.put_line('labc1'||case when exact then 'X' else 'U' end);

    if(p_v2 is null) then
      return p_v1.is_null;
    end if;

    if(not p_v1.is_array) then
      return false;
    end if;

--  dbms_output.put_line('labc2'||case when exact then 'X' else 'U' end);

    cmp := json_list(p_v1);
    if(cmp.count != p_v2.count and exact) then return false; end if;

--  dbms_output.put_line('labc3'||case when exact then 'X' else 'U' end);

    if(exact) then
      for i in 1 .. cmp.count loop
        res := equals(cmp.get(i), p_v2.get(i), exact);
        if(not res) then return res; end if;
      end loop;
    else
--  dbms_output.put_line('labc4'||case when exact then 'X' else 'U' end);
      if(p_v2.count > cmp.count) then return false; end if;
--  dbms_output.put_line('labc5'||case when exact then 'X' else 'U' end);

      --match sublist here!
      for x in 0 .. (cmp.count-p_v2.count) loop
--  dbms_output.put_line('labc7'||x);

        for i in 1 .. p_v2.count loop
          res := equals(cmp.get(x+i), p_v2.get(i), exact);
          if(not res) then
            goto next_index;
          end if;
        end loop;
        return true;

        <<next_index>>
        null;
      end loop;

--  dbms_output.put_line('labc7'||case when exact then 'X' else 'U' end);

    return false; --no match

    end if;

    return res;
  end;

  function equals(p_v1 json_value, p_v2 json, exact boolean) return boolean as
    cmp json;
    res boolean := true;
  begin
--  p_v1.print(false);
--  p_v2.print(false);
--  dbms_output.put_line('abc1');

    if(p_v2 is null) then
      return p_v1.is_null;
    end if;

    if(not p_v1.is_object) then
      return false;
    end if;

    cmp := json(p_v1);

--  dbms_output.put_line('abc2');

    if(cmp.count != p_v2.count and exact) then return false; end if;

--  dbms_output.put_line('abc3');
    declare
      k1 json_list := p_v2.get_keys;
      key_index number;
    begin
      for i in 1 .. k1.count loop
        key_index := cmp.index_of(k1.get(i).get_string);
        if(key_index = -1) then return false; end if;
        if(exact) then
          if(not equals(p_v2.get(i), cmp.get(key_index),true)) then return false; end if;
        else
          --non exact
          declare
            v1 json_value := cmp.get(key_index);
            v2 json_value := p_v2.get(i);
          begin
--  dbms_output.put_line('abc3 1/2');
--            v1.print(false);
--            v2.print(false);

            if(v1.is_object and v2.is_object) then
              if(not equals(v1, v2, false)) then return false; end if;
            elsif(v1.is_array and v2.is_array) then
              if(not equals(v1, v2, false)) then return false; end if;
            else
              if(not equals(v1, v2, true)) then return false; end if;
            end if;
          end;

        end if;
      end loop;
    end;

--  dbms_output.put_line('abc4');

    return true;
  end;

  function equals(p_v1 json, p_v2 json, exact boolean) return boolean as
  begin
    return equals(p_v1.to_json_value, p_v2, exact);
  end;

  function equals(p_v1 json_list, p_v2 json_list, exact boolean) return boolean as
  begin
    return equals(p_v1.to_json_value, p_v2, exact);
  end;

  --contain
  function contains(p_v1 json, p_v2 json_value, exact boolean) return boolean as
    v_values json_list;
  begin
    if(equals(p_v1.to_json_value, p_v2, exact)) then return true; end if;

    v_values := p_v1.get_values;

    for i in 1 .. v_values.count loop
      declare
        v_val json_value := v_values.get(i);
      begin
        if(v_val.is_object) then
          if(contains(json(v_val),p_v2,exact)) then return true; end if;
        end if;
        if(v_val.is_array) then
          if(contains(json_list(v_val),p_v2, exact)) then return true; end if;
        end if;

        if(equals(v_val, p_v2, exact)) then return true; end if;
      end;

    end loop;

    return false;
  end;

  function contains(p_v1 json_list, p_v2 json_value, exact boolean) return boolean as
  begin
    if(equals(p_v1.to_json_value, p_v2, exact)) then return true; end if;

    for i in 1 .. p_v1.count loop
      declare
        v_val json_value := p_v1.get(i);
      begin
        if(v_val.is_object) then
          if(contains(json(v_val),p_v2, exact)) then return true; end if;
        end if;
        if(v_val.is_array) then
          if(contains(json_list(v_val),p_v2, exact)) then return true; end if;
        end if;

        if(equals(v_val, p_v2, exact)) then return true; end if;
      end;

    end loop;

    return false;
  end;

  function contains(p_v1 json, p_v2 json, exact boolean ) return boolean as
  begin return contains(p_v1, p_v2.to_json_value,exact); end;
  function contains(p_v1 json, p_v2 json_list, exact boolean ) return boolean as
  begin return contains(p_v1, p_v2.to_json_value,exact); end;
  function contains(p_v1 json, p_v2 number, exact boolean ) return boolean as begin
  return contains(p_v1, json_value(p_v2),exact); end;
  function contains(p_v1 json, p_v2 varchar2, exact boolean ) return boolean as begin
  return contains(p_v1, json_value(p_v2),exact); end;
  function contains(p_v1 json, p_v2 boolean, exact boolean ) return boolean as begin
  return contains(p_v1, json_value(p_v2),exact); end;
  function contains(p_v1 json, p_v2 clob, exact boolean ) return boolean as begin
  return contains(p_v1, json_value(p_v2),exact); end;

  function contains(p_v1 json_list, p_v2 json, exact boolean ) return boolean as begin
  return contains(p_v1, p_v2.to_json_value,exact); end;
  function contains(p_v1 json_list, p_v2 json_list, exact boolean ) return boolean as begin
  return contains(p_v1, p_v2.to_json_value,exact); end;
  function contains(p_v1 json_list, p_v2 number, exact boolean ) return boolean as begin
  return contains(p_v1, json_value(p_v2),exact); end;
  function contains(p_v1 json_list, p_v2 varchar2, exact boolean ) return boolean as begin
  return contains(p_v1, json_value(p_v2),exact); end;
  function contains(p_v1 json_list, p_v2 boolean, exact boolean ) return boolean as begin
  return contains(p_v1, json_value(p_v2),exact); end;
  function contains(p_v1 json_list, p_v2 clob, exact boolean ) return boolean as begin
  return contains(p_v1, json_value(p_v2),exact); end;


end json_helper;
/

prompt
prompt Creating package body JSON_ML
prompt =============================
prompt
create or replace package body freedom.json_ml as
  function get_jsonml_stylesheet return xmltype;

  function xml2json(xml in xmltype) return json_list as
    l_json        xmltype;
    l_returnvalue clob;
  begin
    l_json := xml.transform (get_jsonml_stylesheet);
    l_returnvalue := l_json.getclobval();
    l_returnvalue := dbms_xmlgen.convert (l_returnvalue, dbms_xmlgen.entity_decode);
    --dbms_output.put_line(l_returnvalue);
    return json_list(l_returnvalue);
  end xml2json;

  function xmlstr2json(xmlstr in varchar2) return json_list as
  begin
    return xml2json(xmltype(xmlstr));
  end xmlstr2json;

  function get_jsonml_stylesheet return xmltype as
  begin
    if(jsonml_stylesheet is null) then
    jsonml_stylesheet := xmltype('<?xml version="1.0" encoding="UTF-8"?>
<!--
		JsonML.xslt

		Created: 2006-11-15-0551
		Modified: 2009-02-14-0927

		Released under an open-source license:
		http://jsonml.org/License.htm

		This transformation converts any XML document into JsonML.
		It omits processing-instructions and comment-nodes.

		To enable comment-nodes to be emitted as JavaScript comments,
		uncomment the Comment() template.
-->
<xsl:stylesheet version="1.0"
				xmlns:xsl="http://www.w3.org/1999/XSL/Transform">

	<xsl:output method="text"
				media-type="application/json"
				encoding="UTF-8"
				indent="no"
				omit-xml-declaration="yes" />

	<!-- constants -->
	<xsl:variable name="XHTML"
				  select="''http://www.w3.org/1999/xhtml''" />

	<xsl:variable name="START_ELEM"
				  select="''[''" />

	<xsl:variable name="END_ELEM"
				  select="'']''" />

	<xsl:variable name="VALUE_DELIM"
				  select="'',''" />

	<xsl:variable name="START_ATTRIB"
				  select="''{''" />

	<xsl:variable name="END_ATTRIB"
				  select="''}''" />

	<xsl:variable name="NAME_DELIM"
				  select="'':''" />

	<xsl:variable name="STRING_DELIM"
				  select="''&#x22;''" />

	<xsl:variable name="START_COMMENT"
				  select="''/*''" />

	<xsl:variable name="END_COMMENT"
				  select="''*/''" />

	<!-- root-node -->
	<xsl:template match="/">
		<xsl:apply-templates select="*" />
	</xsl:template>

	<!-- comments -->
	<xsl:template match="comment()">
	<!-- uncomment to support JSON comments -->
	<!--
		<xsl:value-of select="$START_COMMENT" />

		<xsl:value-of select="."
					  disable-output-escaping="yes" />

		<xsl:value-of select="$END_COMMENT" />
	-->
	</xsl:template>

	<!-- elements -->
	<xsl:template match="*">
		<xsl:value-of select="$START_ELEM" />

		<!-- tag-name string -->
		<xsl:value-of select="$STRING_DELIM" />
		<xsl:choose>
			<xsl:when test="namespace-uri()=$XHTML">
				<xsl:value-of select="local-name()" />
			</xsl:when>
			<xsl:otherwise>
				<xsl:value-of select="name()" />
			</xsl:otherwise>
		</xsl:choose>
		<xsl:value-of select="$STRING_DELIM" />

		<!-- attribute object -->
		<xsl:if test="count(@*)>0">
			<xsl:value-of select="$VALUE_DELIM" />
			<xsl:value-of select="$START_ATTRIB" />
			<xsl:for-each select="@*">
				<xsl:if test="position()>1">
					<xsl:value-of select="$VALUE_DELIM" />
				</xsl:if>
				<xsl:apply-templates select="." />
			</xsl:for-each>
			<xsl:value-of select="$END_ATTRIB" />
		</xsl:if>

		<!-- child elements and text-nodes -->
		<xsl:for-each select="*|text()">
			<xsl:value-of select="$VALUE_DELIM" />
			<xsl:apply-templates select="." />
		</xsl:for-each>

		<xsl:value-of select="$END_ELEM" />
	</xsl:template>

	<!-- text-nodes -->
	<xsl:template match="text()">
		<xsl:call-template name="escape-string">
			<xsl:with-param name="value"
							select="." />
		</xsl:call-template>
	</xsl:template>

	<!-- attributes -->
	<xsl:template match="@*">
		<xsl:value-of select="$STRING_DELIM" />
		<xsl:choose>
			<xsl:when test="namespace-uri()=$XHTML">
				<xsl:value-of select="local-name()" />
			</xsl:when>
			<xsl:otherwise>
				<xsl:value-of select="name()" />
			</xsl:otherwise>
		</xsl:choose>
		<xsl:value-of select="$STRING_DELIM" />

		<xsl:value-of select="$NAME_DELIM" />

		<xsl:call-template name="escape-string">
			<xsl:with-param name="value"
							select="." />
		</xsl:call-template>

	</xsl:template>

	<!-- escape-string: quotes and escapes -->
	<xsl:template name="escape-string">
		<xsl:param name="value" />

		<xsl:value-of select="$STRING_DELIM" />

		<xsl:if test="string-length($value)>0">
			<xsl:variable name="escaped-whacks">
				<!-- escape backslashes -->
				<xsl:call-template name="string-replace">
					<xsl:with-param name="value"
									select="$value" />
					<xsl:with-param name="find"
									select="''\''" />
					<xsl:with-param name="replace"
									select="''\\''" />
				</xsl:call-template>
			</xsl:variable>

			<xsl:variable name="escaped-LF">
				<!-- escape line feeds -->
				<xsl:call-template name="string-replace">
					<xsl:with-param name="value"
									select="$escaped-whacks" />
					<xsl:with-param name="find"
									select="''&#x0A;''" />
					<xsl:with-param name="replace"
									select="''\n''" />
				</xsl:call-template>
			</xsl:variable>

			<xsl:variable name="escaped-CR">
				<!-- escape carriage returns -->
				<xsl:call-template name="string-replace">
					<xsl:with-param name="value"
									select="$escaped-LF" />
					<xsl:with-param name="find"
									select="''&#x0D;''" />
					<xsl:with-param name="replace"
									select="''\r''" />
				</xsl:call-template>
			</xsl:variable>

			<xsl:variable name="escaped-tabs">
				<!-- escape tabs -->
				<xsl:call-template name="string-replace">
					<xsl:with-param name="value"
									select="$escaped-CR" />
					<xsl:with-param name="find"
									select="''&#x09;''" />
					<xsl:with-param name="replace"
									select="''\t''" />
				</xsl:call-template>
			</xsl:variable>

			<!-- escape quotes -->
			<xsl:call-template name="string-replace">
				<xsl:with-param name="value"
								select="$escaped-tabs" />
				<xsl:with-param name="find"
								select="''&quot;''" />
				<xsl:with-param name="replace"
								select="''\&quot;''" />
			</xsl:call-template>
		</xsl:if>

		<xsl:value-of select="$STRING_DELIM" />
	</xsl:template>

	<!-- string-replace: replaces occurances of one string with another -->
	<xsl:template name="string-replace">
		<xsl:param name="value" />
		<xsl:param name="find" />
		<xsl:param name="replace" />

		<xsl:choose>
			<xsl:when test="contains($value,$find)">
				<!-- replace and call recursively on next -->
				<xsl:value-of select="substring-before($value,$find)"
							  disable-output-escaping="yes" />
				<xsl:value-of select="$replace"
							  disable-output-escaping="yes" />
				<xsl:call-template name="string-replace">
					<xsl:with-param name="value"
									select="substring-after($value,$find)" />
					<xsl:with-param name="find"
									select="$find" />
					<xsl:with-param name="replace"
									select="$replace" />
				</xsl:call-template>
			</xsl:when>
			<xsl:otherwise>
				<!-- no replacement necessary -->
				<xsl:value-of select="$value"
							  disable-output-escaping="yes" />
			</xsl:otherwise>
		</xsl:choose>
	</xsl:template>

</xsl:stylesheet>');
    end if;
    return jsonml_stylesheet;
  end get_jsonml_stylesheet;

end json_ml;
/

prompt
prompt Creating package body JSON_PARSER
prompt =================================
prompt
CREATE OR REPLACE PACKAGE BODY FREEDOM."JSON_PARSER" as
  /*
  Copyright (c) 2009 Jonas Krogsboell

  Permission is hereby granted, free of charge, to any person obtaining a copy
  of this software and associated documentation files (the "Software"), to deal
  in the Software without restriction, including without limitation the rights
  to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
  copies of the Software, and to permit persons to whom the Software is
  furnished to do so, subject to the following conditions:

  The above copyright notice and this permission notice shall be included in
  all copies or substantial portions of the Software.

  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
  THE SOFTWARE.
  */

  decimalpoint varchar2(1 char) := '.';

  procedure updateDecimalPoint as
  begin
    SELECT substr(VALUE,1,1) into decimalpoint FROM NLS_SESSION_PARAMETERS WHERE PARAMETER = 'NLS_NUMERIC_CHARACTERS';
  end updateDecimalPoint;

  /*type json_src is record (len number, offset number, src varchar2(10), s_clob clob); */
  function next_char(indx number, s in out nocopy json_src) return varchar2 as
  begin
    if(indx > s.len) then return null; end if;
    --right offset?
    if(indx > 4000 + s.offset or indx < s.offset) then
    --load right offset
      s.offset := indx - (indx mod 4000);
      s.src := dbms_lob.substr(s.s_clob, 4000, s.offset+1);
    end if;
    --read from s.src
    return substr(s.src, indx-s.offset, 1);
  end;

  function next_char2(indx number, s in out nocopy json_src, amount number default 1) return varchar2 as
    buf varchar2(32767) := '';
  begin
    for i in 1..amount loop
      buf := buf || next_char(indx-1+i,s);
    end loop;
    return buf;
  end;

  function prepareClob(buf clob) return json_parser.json_src as
    temp json_parser.json_src;
  begin
    temp.s_clob := buf;
    temp.offset := 0;
    temp.src := dbms_lob.substr(buf, 4000, temp.offset+1);
    temp.len := dbms_lob.getlength(buf);
    return temp;
  end;

  function prepareVarchar2(buf varchar2) return json_parser.json_src as
    temp json_parser.json_src;
  begin
    temp.s_clob := buf;
    temp.offset := 0;
    temp.src := substr(buf, 1, 4000);
    temp.len := length(buf);
    return temp;
  end;

  procedure debug(text varchar2) as
  begin
    dbms_output.put_line(text);
  end;

  procedure print_token(t rToken) as
  begin
    dbms_output.put_line('Line: '||t.line||' - Column: '||t.col||' - Type: '||t.type_name||' - Content: '||t.data);
  end print_token;

  /* SCANNER FUNCTIONS START */
  procedure s_error(text varchar2, line number, col number) as
  begin
    raise_application_error(-20100, 'JSON Scanner exception @ line: '||line||' column: '||col||' - '||text);
  end;

  procedure s_error(text varchar2, tok rToken) as
  begin
    raise_application_error(-20100, 'JSON Scanner exception @ line: '||tok.line||' column: '||tok.col||' - '||text);
  end;

  function mt(t varchar2, l pls_integer, c pls_integer, d varchar2) return rToken as
    token rToken;
  begin
    token.type_name := t;
    token.line := l;
    token.col := c;
    token.data := d;
    return token;
  end;

  function lexNumber(jsrc in out nocopy json_src, tok in out nocopy rToken, indx in out nocopy pls_integer) return pls_integer as
    numbuf varchar2(4000) := '';
    buf varchar2(4);
    checkLoop boolean;
  begin
    buf := next_char(indx, jsrc);
    if(buf = '-') then numbuf := '-'; indx := indx + 1; end if;
    buf := next_char(indx, jsrc);
    --0 or [1-9]([0-9])*
    if(buf = '0') then
      numbuf := numbuf || '0'; indx := indx + 1;
      buf := next_char(indx, jsrc);
    elsif(buf >= '1' and buf <= '9') then
      numbuf := numbuf || buf; indx := indx + 1;
      --read digits
      buf := next_char(indx, jsrc);
      while(buf >= '0' and buf <= '9') loop
        numbuf := numbuf || buf; indx := indx + 1;
        buf := next_char(indx, jsrc);
      end loop;
    end if;
    --fraction
    if(buf = '.') then
      numbuf := numbuf || buf; indx := indx + 1;
      buf := next_char(indx, jsrc);
      checkLoop := FALSE;
      while(buf >= '0' and buf <= '9') loop
        checkLoop := TRUE;
        numbuf := numbuf || buf; indx := indx + 1;
        buf := next_char(indx, jsrc);
      end loop;
      if(not checkLoop) then
        s_error('Expected: digits in fraction', tok);
      end if;
    end if;
    --exp part
    if(buf in ('e', 'E')) then
      numbuf := numbuf || buf; indx := indx + 1;
      buf := next_char(indx, jsrc);
      if(buf = '+' or buf = '-') then
        numbuf := numbuf || buf; indx := indx + 1;
        buf := next_char(indx, jsrc);
      end if;
      checkLoop := FALSE;
      while(buf >= '0' and buf <= '9') loop
        checkLoop := TRUE;
        numbuf := numbuf || buf; indx := indx + 1;
        buf := next_char(indx, jsrc);
      end loop;
      if(not checkLoop) then
        s_error('Expected: digits in exp', tok);
      end if;
    end if;

    tok.data := numbuf;
    return indx;
  end lexNumber;

  -- [a-zA-Z]([a-zA-Z0-9])*
  function lexName(jsrc in out nocopy json_src, tok in out nocopy rToken, indx in out nocopy pls_integer) return pls_integer as
    varbuf varchar2(32767) := '';
    buf varchar(4);
    num number;
  begin
    buf := next_char(indx, jsrc);
    while(REGEXP_LIKE(buf, '^[[:alnum:]\_]$', 'i')) loop
      varbuf := varbuf || buf;
      indx := indx + 1;
      buf := next_char(indx, jsrc);
      if (buf is null) then
        goto retname;
        --debug('Premature string ending');
      end if;
    end loop;
    <<retname>>

    --could check for reserved keywords here

    --debug(varbuf);
    tok.data := varbuf;
    return indx-1;
  end lexName;

  procedure updateClob(v_extended in out nocopy clob, v_str varchar2) as
  begin
    dbms_lob.writeappend(v_extended, length(v_str), v_str);
  end updateClob;

  function lexString(jsrc in out nocopy json_src, tok in out nocopy rToken, indx in out nocopy pls_integer, endChar char) return pls_integer as
    v_extended clob := null; v_count number := 0;
    varbuf varchar2(32767) := '';
    buf varchar(4);
    wrong boolean;
  begin
    indx := indx +1;
    buf := next_char(indx, jsrc);
    while(buf != endChar) loop
      --clob control
      if(v_count > 8191) then --crazy oracle error (16383 is the highest working length with unistr - 8192 choosen to be safe)
        if(v_extended is null) then
          v_extended := empty_clob();
          dbms_lob.createtemporary(v_extended, true);
        end if;
        updateClob(v_extended, unistr(varbuf));
        varbuf := ''; v_count := 0;
      end if;
      if(buf = Chr(13) or buf = CHR(9) or buf = CHR(10)) then
        s_error('Control characters not allowed (CHR(9),CHR(10)CHR(13))', tok);
      end if;
      if(buf = '\') then
        --varbuf := varbuf || buf;
        indx := indx + 1;
        buf := next_char(indx, jsrc);
        case
          when buf in ('\') then
            varbuf := varbuf || buf || buf; v_count := v_count + 2;
            indx := indx + 1;
            buf := next_char(indx, jsrc);
          when buf in ('"', '/') then
            varbuf := varbuf || buf; v_count := v_count + 1;
            indx := indx + 1;
            buf := next_char(indx, jsrc);
          when buf = '''' then
            if(json_strict = false) then
              varbuf := varbuf || buf; v_count := v_count + 1;
              indx := indx + 1;
              buf := next_char(indx, jsrc);
            else
              s_error('strictmode - expected: " \ / b f n r t u ', tok);
            end if;
          when buf in ('b', 'f', 'n', 'r', 't') then
            --backspace b = U+0008
            --formfeed  f = U+000C
            --newline   n = U+000A
            --carret    r = U+000D
            --tabulator t = U+0009
            case buf
            when 'b' then varbuf := varbuf || chr(8);
            when 'f' then varbuf := varbuf || chr(13);
            when 'n' then varbuf := varbuf || chr(10);
            when 'r' then varbuf := varbuf || chr(14);
            when 't' then varbuf := varbuf || chr(9);
            end case;
            --varbuf := varbuf || buf;
            v_count := v_count + 1;
            indx := indx + 1;
            buf := next_char(indx, jsrc);
          when buf = 'u' then
            --four hexidecimal chars
            declare
              four varchar2(4);
            begin
              four := next_char2(indx+1, jsrc, 4);
              wrong := FALSE;
              if(upper(substr(four, 1,1)) not in ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F','a','b','c','d','e','f')) then wrong := TRUE; end if;
              if(upper(substr(four, 2,1)) not in ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F','a','b','c','d','e','f')) then wrong := TRUE; end if;
              if(upper(substr(four, 3,1)) not in ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F','a','b','c','d','e','f')) then wrong := TRUE; end if;
              if(upper(substr(four, 4,1)) not in ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F','a','b','c','d','e','f')) then wrong := TRUE; end if;
              if(wrong) then
                s_error('expected: " \u([0-9][A-F]){4}', tok);
              end if;
--              varbuf := varbuf || buf || four;
              varbuf := varbuf || '\'||four;--chr(to_number(four,'XXXX'));
               v_count := v_count + 5;
              indx := indx + 5;
              buf := next_char(indx, jsrc);
              end;
          else
            s_error('expected: " \ / b f n r t u ', tok);
        end case;
      else
        varbuf := varbuf || buf; v_count := v_count + 1;
        indx := indx + 1;
        buf := next_char(indx, jsrc);
      end if;
    end loop;

    if (buf is null) then
      s_error('string ending not found', tok);
      --debug('Premature string ending');
    end if;

    --debug(varbuf);
    --dbms_output.put_line(varbuf);
    if(v_extended is not null) then
      updateClob(v_extended, unistr(varbuf));
      tok.data_overflow := v_extended;
      tok.data := dbms_lob.substr(v_extended, 1, 32767);
    else
      tok.data := unistr(varbuf);
    end if;
    return indx;
  end lexString;

  /* scanner tokens:
    '{', '}', ',', ':', '[', ']', STRING, NUMBER, TRUE, FALSE, NULL
  */
  function lexer(jsrc in out nocopy json_src) return lTokens as
    tokens lTokens;
    indx pls_integer := 1;
    tok_indx pls_integer := 1;
    buf varchar2(4);
    lin_no number := 1;
    col_no number := 0;
  begin
    while (indx <= jsrc.len) loop
      --read into buf
      buf := next_char(indx, jsrc);
      col_no := col_no + 1;
      --convert to switch case
      case
        when buf = '{' then tokens(tok_indx) := mt('{', lin_no, col_no, null); tok_indx := tok_indx + 1;
        when buf = '}' then tokens(tok_indx) := mt('}', lin_no, col_no, null); tok_indx := tok_indx + 1;
        when buf = ',' then tokens(tok_indx) := mt(',', lin_no, col_no, null); tok_indx := tok_indx + 1;
        when buf = ':' then tokens(tok_indx) := mt(':', lin_no, col_no, null); tok_indx := tok_indx + 1;
        when buf = '[' then tokens(tok_indx) := mt('[', lin_no, col_no, null); tok_indx := tok_indx + 1;
        when buf = ']' then tokens(tok_indx) := mt(']', lin_no, col_no, null); tok_indx := tok_indx + 1;
        when buf = 't' then
          if(next_char2(indx, jsrc, 4) != 'true') then
            if(json_strict = false and REGEXP_LIKE(buf, '^[[:alpha:]]$', 'i')) then
              tokens(tok_indx) := mt('STRING', lin_no, col_no, null);
              indx := lexName(jsrc, tokens(tok_indx), indx);
              col_no := col_no + length(tokens(tok_indx).data) + 1;
              tok_indx := tok_indx + 1;
            else
              s_error('Expected: ''true''', lin_no, col_no);
            end if;
          else
            tokens(tok_indx) := mt('TRUE', lin_no, col_no, null); tok_indx := tok_indx + 1;
            indx := indx + 3;
            col_no := col_no + 3;
          end if;
        when buf = 'n' then
          if(next_char2(indx, jsrc, 4) != 'null') then
            if(json_strict = false and REGEXP_LIKE(buf, '^[[:alpha:]]$', 'i')) then
              tokens(tok_indx) := mt('STRING', lin_no, col_no, null);
              indx := lexName(jsrc, tokens(tok_indx), indx);
              col_no := col_no + length(tokens(tok_indx).data) + 1;
              tok_indx := tok_indx + 1;
            else
              s_error('Expected: ''null''', lin_no, col_no);
            end if;
          else
            tokens(tok_indx) := mt('NULL', lin_no, col_no, null); tok_indx := tok_indx + 1;
            indx := indx + 3;
            col_no := col_no + 3;
          end if;
        when buf = 'f' then
          if(next_char2(indx, jsrc, 5) != 'false') then
            if(json_strict = false and REGEXP_LIKE(buf, '^[[:alpha:]]$', 'i')) then
              tokens(tok_indx) := mt('STRING', lin_no, col_no, null);
              indx := lexName(jsrc, tokens(tok_indx), indx);
              col_no := col_no + length(tokens(tok_indx).data) + 1;
              tok_indx := tok_indx + 1;
            else
              s_error('Expected: ''false''', lin_no, col_no);
            end if;
          else
            tokens(tok_indx) := mt('FALSE', lin_no, col_no, null); tok_indx := tok_indx + 1;
            indx := indx + 4;
            col_no := col_no + 4;
          end if;
        /*   -- 9 = TAB, 10 = \n, 13 = \r (Linux = \n, Windows = \r\n, Mac = \r */
        when (buf = Chr(10)) then --linux newlines
          lin_no := lin_no + 1;
          col_no := 0;

        when (buf = Chr(13)) then --Windows or Mac way
          lin_no := lin_no + 1;
          col_no := 0;
          if(jsrc.len >= indx +1) then -- better safe than sorry
            buf := next_char(indx+1, jsrc);
            if(buf = Chr(10)) then --\r\n
              indx := indx + 1;
            end if;
          end if;

        when (buf = CHR(9)) then null; --tabbing
        when (buf in ('-', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9')) then --number
          tokens(tok_indx) := mt('NUMBER', lin_no, col_no, null);
          indx := lexNumber(jsrc, tokens(tok_indx), indx)-1;
          col_no := col_no + length(tokens(tok_indx).data);
          tok_indx := tok_indx + 1;
        when buf = '"' then --number
          tokens(tok_indx) := mt('STRING', lin_no, col_no, null);
          indx := lexString(jsrc, tokens(tok_indx), indx, '"');
          col_no := col_no + length(tokens(tok_indx).data) + 1;
          tok_indx := tok_indx + 1;
        when buf = '''' and json_strict = false then --number
          tokens(tok_indx) := mt('STRING', lin_no, col_no, null);
          indx := lexString(jsrc, tokens(tok_indx), indx, '''');
          col_no := col_no + length(tokens(tok_indx).data) + 1; --hovsa her
          tok_indx := tok_indx + 1;
        when json_strict = false and REGEXP_LIKE(buf, '^[[:alpha:]]$', 'i') then
          tokens(tok_indx) := mt('STRING', lin_no, col_no, null);
          indx := lexName(jsrc, tokens(tok_indx), indx);
          if(tokens(tok_indx).data_overflow is not null) then
            col_no := col_no + dbms_lob.getlength(tokens(tok_indx).data_overflow) + 1;
          else
            col_no := col_no + length(tokens(tok_indx).data) + 1;
          end if;
          tok_indx := tok_indx + 1;
        when json_strict = false and buf||next_char(indx+1, jsrc) = '/*' then --strip comments
          declare
            saveindx number := indx;
            un_esc clob;
          begin
            indx := indx + 1;
            loop
              indx := indx + 1;
              buf := next_char(indx, jsrc)||next_char(indx+1, jsrc);
              exit when buf = '*/';
              exit when buf is null;
            end loop;

            if(indx = saveindx+2) then
              --enter unescaped mode
              --dbms_output.put_line('Entering unescaped mode');
              un_esc := empty_clob();
              dbms_lob.createtemporary(un_esc, true);
              indx := indx + 1;
              loop
                indx := indx + 1;
                buf := next_char(indx, jsrc)||next_char(indx+1, jsrc)||next_char(indx+2, jsrc)||next_char(indx+3, jsrc);
                exit when buf = '/**/';
                if buf is null then
                  s_error('Unexpected sequence /**/ to end unescaped data: '||buf, lin_no, col_no);
                end if;
                buf := next_char(indx, jsrc);
                dbms_lob.writeappend(un_esc, length(buf), buf);
              end loop;
              tokens(tok_indx) := mt('ESTRING', lin_no, col_no, null);
              tokens(tok_indx).data_overflow := un_esc;
              col_no := col_no + dbms_lob.getlength(un_esc) + 1; --note: line count won't work properly
              tok_indx := tok_indx + 1;
              indx := indx + 2;
            end if;

            indx := indx + 1;
          end;
        when buf = ' ' then null; --space
        else
          s_error('Unexpected char: '||buf, lin_no, col_no);
      end case;

      indx := indx + 1;
    end loop;

    return tokens;
  end lexer;

  /* SCANNER END */

  /* PARSER FUNCTIONS START*/
  procedure p_error(text varchar2, tok rToken) as
  begin
    raise_application_error(-20101, 'JSON Parser exception @ line: '||tok.line||' column: '||tok.col||' - '||text);
  end;

  function parseObj(tokens lTokens, indx in out nocopy pls_integer) return json;

  function parseArr(tokens lTokens, indx in out nocopy pls_integer) return json_list as
    e_arr json_value_array := json_value_array();
    ret_list json_list := json_list();
    v_count number := 0;
    tok rToken;
  begin
    --value, value, value ]
    if(indx > tokens.count) then p_error('more elements in array was excepted', tok); end if;
    tok := tokens(indx);
    while(tok.type_name != ']') loop
      e_arr.extend;
      v_count := v_count + 1;
      case tok.type_name
        when 'TRUE' then e_arr(v_count) := json_value(true);
        when 'FALSE' then e_arr(v_count) := json_value(false);
        when 'NULL' then e_arr(v_count) := json_value;
        when 'STRING' then e_arr(v_count) := case when tok.data_overflow is not null then json_value(tok.data_overflow) else json_value(tok.data) end;
        when 'ESTRING' then e_arr(v_count) := json_value(tok.data_overflow, false);
        when 'NUMBER' then e_arr(v_count) := json_value(to_number(replace(tok.data, '.', decimalpoint)));
        when '[' then
          declare e_list json_list; begin
            indx := indx + 1;
            e_list := parseArr(tokens, indx);
            e_arr(v_count) := e_list.to_json_value;
          end;
        when '{' then
          indx := indx + 1;
          e_arr(v_count) := parseObj(tokens, indx).to_json_value;
        else
          p_error('Expected a value', tok);
      end case;
      indx := indx + 1;
      if(indx > tokens.count) then p_error('] not found', tok); end if;
      tok := tokens(indx);
      if(tok.type_name = ',') then --advance
        indx := indx + 1;
        if(indx > tokens.count) then p_error('more elements in array was excepted', tok); end if;
        tok := tokens(indx);
        if(tok.type_name = ']') then --premature exit
          p_error('Premature exit in array', tok);
        end if;
      elsif(tok.type_name != ']') then --error
        p_error('Expected , or ]', tok);
      end if;

    end loop;
    ret_list.list_data := e_arr;
    return ret_list;
  end parseArr;

  function parseMem(tokens lTokens, indx in out pls_integer, mem_name varchar2, mem_indx number) return json_value as
    mem json_value;
    tok rToken;
  begin
    tok := tokens(indx);
    case tok.type_name
      when 'TRUE' then mem := json_value(true);
      when 'FALSE' then mem := json_value(false);
      when 'NULL' then mem := json_value;
      when 'STRING' then mem := case when tok.data_overflow is not null then json_value(tok.data_overflow) else json_value(tok.data) end;
      when 'ESTRING' then mem := json_value(tok.data_overflow, false);
      when 'NUMBER' then mem := json_value(to_number(replace(tok.data, '.', decimalpoint)));
      when '[' then
        declare
          e_list json_list;
        begin
          indx := indx + 1;
          e_list := parseArr(tokens, indx);
          mem := e_list.to_json_value;
        end;
      when '{' then
        indx := indx + 1;
        mem := parseObj(tokens, indx).to_json_value;
      else
        p_error('Found '||tok.type_name, tok);
    end case;
    mem.mapname := mem_name;
    mem.mapindx := mem_indx;

    indx := indx + 1;
    return mem;
  end parseMem;

  /*procedure test_duplicate_members(arr in json_member_array, mem_name in varchar2, wheretok rToken) as
  begin
    for i in 1 .. arr.count loop
      if(arr(i).member_name = mem_name) then
        p_error('Duplicate member name', wheretok);
      end if;
    end loop;
  end test_duplicate_members;*/

  function parseObj(tokens lTokens, indx in out nocopy pls_integer) return json as
    type memmap is table of number index by varchar2(4000); -- i've read somewhere that this is not possible - but it is!
    mymap memmap;
    nullelemfound boolean := false;

    obj json;
    tok rToken;
    mem_name varchar(4000);
    arr json_value_array := json_value_array();
  begin
    --what to expect?
    while(indx <= tokens.count) loop
      tok := tokens(indx);
      --debug('E: '||tok.type_name);
      case tok.type_name
      when 'STRING' then
        --member
        mem_name := substr(tok.data, 1, 4000);
        begin
          if(mem_name is null) then
            if(nullelemfound) then
              p_error('Duplicate empty member: ', tok);
            else
              nullelemfound := true;
            end if;
          elsif(mymap(mem_name) is not null) then
            p_error('Duplicate member name: '||mem_name, tok);
          end if;
        exception
          when no_data_found then mymap(mem_name) := 1;
        end;

        indx := indx + 1;
        if(indx > tokens.count) then p_error('Unexpected end of input', tok); end if;
        tok := tokens(indx);
        indx := indx + 1;
        if(indx > tokens.count) then p_error('Unexpected end of input', tok); end if;
        if(tok.type_name = ':') then
          --parse
          declare
            jmb json_value;
            x number;
          begin
            x := arr.count + 1;
            jmb := parseMem(tokens, indx, mem_name, x);
            arr.extend;
            arr(x) := jmb;
          end;
        else
          p_error('Expected '':''', tok);
        end if;
        --move indx forward if ',' is found
        if(indx > tokens.count) then p_error('Unexpected end of input', tok); end if;

        tok := tokens(indx);
        if(tok.type_name = ',') then
          --debug('found ,');
          indx := indx + 1;
          tok := tokens(indx);
          if(tok.type_name = '}') then --premature exit
            p_error('Premature exit in json object', tok);
          end if;
        elsif(tok.type_name != '}') then
           p_error('A comma seperator is probably missing', tok);
        end if;
      when '}' then
        obj := json();
        obj.json_data := arr;
        return obj;
      else
        p_error('Expected string or }', tok);
      end case;
    end loop;

    p_error('} not found', tokens(indx-1));

    return obj;

  end;

  function parser(str varchar2) return json as
    tokens lTokens;
    obj json;
    indx pls_integer := 1;
    jsrc json_src;
  begin
    updateDecimalPoint();
    jsrc := prepareVarchar2(str);
    tokens := lexer(jsrc);
    if(tokens(indx).type_name = '{') then
      indx := indx + 1;
      obj := parseObj(tokens, indx);
    else
      raise_application_error(-20101, 'JSON Parser exception - no { start found');
    end if;
    if(tokens.count != indx) then
      p_error('} should end the JSON object', tokens(indx));
    end if;

    return obj;
  end parser;

  function parse_list(str varchar2) return json_list as
    tokens lTokens;
    obj json_list;
    indx pls_integer := 1;
    jsrc json_src;
  begin
    updateDecimalPoint();
    jsrc := prepareVarchar2(str);
    tokens := lexer(jsrc);
    if(tokens(indx).type_name = '[') then
      indx := indx + 1;
      obj := parseArr(tokens, indx);
    else
      raise_application_error(-20101, 'JSON List Parser exception - no [ start found');
    end if;
    if(tokens.count != indx) then
      p_error('] should end the JSON List object', tokens(indx));
    end if;

    return obj;
  end parse_list;

  function parse_list(str clob) return json_list as
    tokens lTokens;
    obj json_list;
    indx pls_integer := 1;
    jsrc json_src;
  begin
    updateDecimalPoint();
    jsrc := prepareClob(str);
    tokens := lexer(jsrc);
    if(tokens(indx).type_name = '[') then
      indx := indx + 1;
      obj := parseArr(tokens, indx);
    else
      raise_application_error(-20101, 'JSON List Parser exception - no [ start found');
    end if;
    if(tokens.count != indx) then
      p_error('] should end the JSON List object', tokens(indx));
    end if;

    return obj;
  end parse_list;

  function parser(str clob) return json as
    tokens lTokens;
    obj json;
    indx pls_integer := 1;
    jsrc json_src;
  begin
    updateDecimalPoint();
    --dbms_output.put_line('Using clob');
    jsrc := prepareClob(str);
    tokens := lexer(jsrc);
    if(tokens(indx).type_name = '{') then
      indx := indx + 1;
      obj := parseObj(tokens, indx);
    else
      raise_application_error(-20101, 'JSON Parser exception - no { start found');
    end if;
    if(tokens.count != indx) then
      p_error('} should end the JSON object', tokens(indx));
    end if;

    return obj;
  end parser;

  function parse_any(str varchar2) return json_value as
    tokens lTokens;
    obj json_list;
    ret json_value;
    indx pls_integer := 1;
    jsrc json_src;
  begin
    updateDecimalPoint();
    jsrc := prepareVarchar2(str);
    tokens := lexer(jsrc);
    tokens(tokens.count+1).type_name := ']';
    obj := parseArr(tokens, indx);
    if(tokens.count != indx) then
      p_error('] should end the JSON List object', tokens(indx));
    end if;

    return obj.head();
  end parse_any;

  function parse_any(str clob) return json_value as
    tokens lTokens;
    obj json_list;
    indx pls_integer := 1;
    jsrc json_src;
  begin
    jsrc := prepareClob(str);
    tokens := lexer(jsrc);
    tokens(tokens.count+1).type_name := ']';
    obj := parseArr(tokens, indx);
    if(tokens.count != indx) then
      p_error('] should end the JSON List object', tokens(indx));
    end if;

    return obj.head();
  end parse_any;

  /* last entry is the one to keep */
  procedure remove_duplicates(obj in out nocopy json) as
    type memberlist is table of json_value index by varchar2(4000);
    members memberlist;
    nulljsonvalue json_value := null;
    validated json := json();
    indx varchar2(4000);
  begin
    for i in 1 .. obj.count loop
      if(obj.get(i).mapname is null) then
        nulljsonvalue := obj.get(i);
      else
        members(obj.get(i).mapname) := obj.get(i);
      end if;
    end loop;

    validated.check_duplicate(false);
    indx := members.first;
    loop
      exit when indx is null;
      validated.put(indx, members(indx));
      indx := members.next(indx);
    end loop;
    if(nulljsonvalue is not null) then
      validated.put('', nulljsonvalue);
    end if;

    validated.check_for_duplicate := obj.check_for_duplicate;

    obj := validated;
  end;

  function get_version return varchar2 as
  begin
    return 'PL/JSON v1.0.4';
  end get_version;

end json_parser;
/

prompt
prompt Creating package body JSON_PRINTER
prompt ==================================
prompt
create or replace package body freedom."JSON_PRINTER" as
  max_line_len number := 0;
  cur_line_len number := 0;

  function llcheck(str in varchar2) return varchar2 as
  begin
    --dbms_output.put_line(cur_line_len || ' : '|| str);
    if(max_line_len > 0 and length(str)+cur_line_len > max_line_len) then
      cur_line_len := length(str);
      return newline_char || str;
    else
      cur_line_len := cur_line_len + length(str);
      return str;
    end if;
  end llcheck;

  function escapeString(str varchar2) return varchar2 as
    sb varchar2(32767) := '';
    buf varchar2(40);
    num number;
  begin
    if(str is null) then return ''; end if;
    for i in 1 .. length(str) loop
      buf := substr(str, i, 1);
      --backspace b = U+0008
      --formfeed  f = U+000C
      --newline   n = U+000A
      --carret    r = U+000D
      --tabulator t = U+0009
      case buf
      when chr( 8) then buf := '\b';
      when chr( 9) then buf := '\t';
      when chr(10) then buf := '\n';
      when chr(13) then buf := '\f';
      when chr(14) then buf := '\r';
      when chr(34) then buf := '\"';
      when chr(47) then if(escape_solidus) then buf := '\/'; end if;
      when chr(92) then buf := '\\';
      else
        if(ascii(buf) < 32) then
          buf := '\u'||replace(substr(to_char(ascii(buf), 'XXXX'),2,4), ' ', '0');
        elsif (ascii_output) then
          buf := replace(asciistr(buf), '\', '\u');
        end if;
      end case;

      sb := sb || buf;
    end loop;

    return sb;
  end escapeString;

  function newline(spaces boolean) return varchar2 as
  begin
    cur_line_len := 0;
    if(spaces) then return newline_char; else return ''; end if;
  end;

/*  function get_schema return varchar2 as
  begin
    return sys_context('userenv', 'current_schema');
  end;
*/
  function tab(indent number, spaces boolean) return varchar2 as
    i varchar(200) := '';
  begin
    if(not spaces) then return ''; end if;
    for x in 1 .. indent loop i := i || indent_string; end loop;
    return i;
  end;

  function getCommaSep(spaces boolean) return varchar2 as
  begin
    if(spaces) then return ', '; else return ','; end if;
  end;

  function getMemName(mem json_value, spaces boolean) return varchar2 as
  begin
    if(spaces) then
      return llcheck('"'||escapeString(mem.mapname)||'"') || llcheck(' : ');
    else
      return llcheck('"'||escapeString(mem.mapname)||'"') || llcheck(':');
    end if;
  end;

/* Clob method start here */
  procedure add_to_clob(buf_lob in out nocopy clob, buf_str in out nocopy varchar2, str varchar2) as
  begin
    if(lengthb(str) > 32767 - lengthb(buf_str)) then
--      dbms_lob.append(buf_lob, buf_str);
      dbms_lob.writeappend(buf_lob, length(buf_str), buf_str);
      buf_str := str;
    else
      buf_str := buf_str || str;
    end if;
  end add_to_clob;

  procedure flush_clob(buf_lob in out nocopy clob, buf_str in out nocopy varchar2) as
  begin
--    dbms_lob.append(buf_lob, buf_str);
    dbms_lob.writeappend(buf_lob, length(buf_str), buf_str);
  end flush_clob;

  procedure ppObj(obj json, indent number, buf in out nocopy clob, spaces boolean, buf_str in out nocopy varchar2);

  procedure ppEA(input json_list, indent number, buf in out nocopy clob, spaces boolean, buf_str in out nocopy varchar2) as
    elem json_value;
    arr json_value_array := input.list_data;
    numbuf varchar2(4000);
  begin
    for y in 1 .. arr.count loop
      elem := arr(y);
      if(elem is not null) then
      case elem.get_type
        when 'number' then
          numbuf := '';
          if (elem.get_number < 1 and elem.get_number > 0) then numbuf := '0'; end if;
          if (elem.get_number < 0 and elem.get_number > -1) then
            numbuf := '-0';
            numbuf := numbuf || substr(to_char(elem.get_number, 'TM9', 'NLS_NUMERIC_CHARACTERS=''.,'''),2);
          else
            numbuf := numbuf || to_char(elem.get_number, 'TM9', 'NLS_NUMERIC_CHARACTERS=''.,''');
          end if;
          add_to_clob(buf, buf_str, llcheck(numbuf));
        when 'string' then
          if(elem.extended_str is not null) then --clob implementation
            add_to_clob(buf, buf_str, case when elem.num = 1 then '"' else '/**/' end);
            declare
              offset number := 1;
              v_str varchar(32767);
              amount number := 32767;
            begin
              while(offset <= dbms_lob.getlength(elem.extended_str)) loop
                dbms_lob.read(elem.extended_str, amount, offset, v_str);
                if(elem.num = 1) then
                  add_to_clob(buf, buf_str, escapeString(v_str));
                else
                  add_to_clob(buf, buf_str, v_str);
                end if;
                offset := offset + amount;
              end loop;
            end;
            add_to_clob(buf, buf_str, case when elem.num = 1 then '"' else '/**/' end || newline_char);
          else
            if(elem.num = 1) then
              add_to_clob(buf, buf_str, llcheck('"'||escapeString(elem.get_string)||'"'));
            else
              add_to_clob(buf, buf_str, llcheck('/**/'||elem.get_string||'/**/'));
            end if;
          end if;
        when 'bool' then
          if(elem.get_bool) then
            add_to_clob(buf, buf_str, llcheck('true'));
          else
            add_to_clob(buf, buf_str, llcheck('false'));
          end if;
        when 'null' then
          add_to_clob(buf, buf_str, llcheck('null'));
        when 'array' then
          add_to_clob(buf, buf_str, llcheck('['));
          ppEA(json_list(elem), indent, buf, spaces, buf_str);
          add_to_clob(buf, buf_str, llcheck(']'));
        when 'object' then
          ppObj(json(elem), indent, buf, spaces, buf_str);
        else add_to_clob(buf, buf_str, llcheck(elem.get_type));
      end case;
      end if;
      if(y != arr.count) then add_to_clob(buf, buf_str, llcheck(getCommaSep(spaces))); end if;
    end loop;
  end ppEA;

  procedure ppMem(mem json_value, indent number, buf in out nocopy clob, spaces boolean, buf_str in out nocopy varchar2) as
    numbuf varchar2(4000);
  begin
    add_to_clob(buf, buf_str, llcheck(tab(indent, spaces)) || llcheck(getMemName(mem, spaces)));
    case mem.get_type
      when 'number' then
        if (mem.get_number < 1 and mem.get_number > 0) then numbuf := '0'; end if;
        if (mem.get_number < 0 and mem.get_number > -1) then
          numbuf := '-0';
          numbuf := numbuf || substr(to_char(mem.get_number, 'TM9', 'NLS_NUMERIC_CHARACTERS=''.,'''),2);
        else
          numbuf := numbuf || to_char(mem.get_number, 'TM9', 'NLS_NUMERIC_CHARACTERS=''.,''');
        end if;
        add_to_clob(buf, buf_str, llcheck(numbuf));
      when 'string' then
        if(mem.extended_str is not null) then --clob implementation
          add_to_clob(buf, buf_str, case when mem.num = 1 then '"' else '/**/' end);
          declare
            offset number := 1;
            v_str varchar(32767);
            amount number := 32767;
          begin
--            dbms_output.put_line('SIZE:'||dbms_lob.getlength(mem.extended_str));
            while(offset <= dbms_lob.getlength(mem.extended_str)) loop
--            dbms_output.put_line('OFFSET:'||offset);
 --             v_str := dbms_lob.substr(mem.extended_str, 8192, offset);
              dbms_lob.read(mem.extended_str, amount, offset, v_str);
--            dbms_output.put_line('VSTR_SIZE:'||length(v_str));
              if(mem.num = 1) then
                add_to_clob(buf, buf_str, escapeString(v_str));
              else
                add_to_clob(buf, buf_str, v_str);
              end if;
              offset := offset + amount;
            end loop;
          end;
          add_to_clob(buf, buf_str, case when mem.num = 1 then '"' else '/**/' end || newline_char);
        else
          if(mem.num = 1) then
            add_to_clob(buf, buf_str, llcheck('"'||escapeString(mem.get_string)||'"'));
          else
            add_to_clob(buf, buf_str, llcheck('/**/'||mem.get_string||'/**/'));
          end if;
        end if;
      when 'bool' then
        if(mem.get_bool) then
          add_to_clob(buf, buf_str, llcheck('true'));
        else
          add_to_clob(buf, buf_str, llcheck('false'));
        end if;
      when 'null' then
        add_to_clob(buf, buf_str, llcheck('null'));
      when 'array' then
        add_to_clob(buf, buf_str, llcheck('['));
        ppEA(json_list(mem), indent, buf, spaces, buf_str);
        add_to_clob(buf, buf_str, llcheck(']'));
      when 'object' then
        ppObj(json(mem), indent, buf, spaces, buf_str);
      else add_to_clob(buf, buf_str, llcheck(mem.get_type));
    end case;
  end ppMem;

  procedure ppObj(obj json, indent number, buf in out nocopy clob, spaces boolean, buf_str in out nocopy varchar2) as
  begin
    add_to_clob(buf, buf_str, llcheck('{') || newline(spaces));
    for m in 1 .. obj.json_data.count loop
      ppMem(obj.json_data(m), indent+1, buf, spaces, buf_str);
      if(m != obj.json_data.count) then
        add_to_clob(buf, buf_str, llcheck(',') || newline(spaces));
      else
        add_to_clob(buf, buf_str, newline(spaces));
      end if;
    end loop;
    add_to_clob(buf, buf_str, llcheck(tab(indent, spaces)) || llcheck('}')); -- || chr(13);
  end ppObj;

  procedure pretty_print(obj json, spaces boolean default true, buf in out nocopy clob, line_length number default 0, erase_clob boolean default true) as
    buf_str varchar2(32767);
    amount number := dbms_lob.getlength(buf);
  begin
    if(erase_clob and amount > 0) then dbms_lob.trim(buf, 0); dbms_lob.erase(buf, amount); end if;

    max_line_len := line_length;
    cur_line_len := 0;
    ppObj(obj, 0, buf, spaces, buf_str);
    flush_clob(buf, buf_str);
  end;

  procedure pretty_print_list(obj json_list, spaces boolean default true, buf in out nocopy clob, line_length number default 0, erase_clob boolean default true) as
    buf_str varchar2(32767);
    amount number := dbms_lob.getlength(buf);
  begin
    if(erase_clob and amount > 0) then dbms_lob.trim(buf, 0); dbms_lob.erase(buf, amount); end if;

    max_line_len := line_length;
    cur_line_len := 0;
    add_to_clob(buf, buf_str, llcheck('['));
    ppEA(obj, 0, buf, spaces, buf_str);
    add_to_clob(buf, buf_str, llcheck(']'));
    flush_clob(buf, buf_str);
  end;

  procedure pretty_print_any(json_part json_value, spaces boolean default true, buf in out nocopy clob, line_length number default 0, erase_clob boolean default true) as
    buf_str varchar2(32767) := '';
    numbuf varchar2(4000);
    amount number := dbms_lob.getlength(buf);
  begin
    if(erase_clob and amount > 0) then dbms_lob.trim(buf, 0); dbms_lob.erase(buf, amount); end if;

    case json_part.get_type
      when 'number' then
        if (json_part.get_number < 1 and json_part.get_number > 0) then numbuf := '0'; end if;
        if (json_part.get_number < 0 and json_part.get_number > -1) then
          numbuf := '-0';
          numbuf := numbuf || substr(to_char(json_part.get_number, 'TM9', 'NLS_NUMERIC_CHARACTERS=''.,'''),2);
        else
          numbuf := numbuf || to_char(json_part.get_number, 'TM9', 'NLS_NUMERIC_CHARACTERS=''.,''');
        end if;
        add_to_clob(buf, buf_str, numbuf);
      when 'string' then
        if(json_part.extended_str is not null) then --clob implementation
          add_to_clob(buf, buf_str, case when json_part.num = 1 then '"' else '/**/' end);
          declare
            offset number := 1;
            v_str varchar(32767);
            amount number := 32767;
          begin
            while(offset <= dbms_lob.getlength(json_part.extended_str)) loop
              dbms_lob.read(json_part.extended_str, amount, offset, v_str);
              if(json_part.num = 1) then
                add_to_clob(buf, buf_str, escapeString(v_str));
              else
                add_to_clob(buf, buf_str, v_str);
              end if;
              offset := offset + amount;
            end loop;
          end;
          add_to_clob(buf, buf_str, case when json_part.num = 1 then '"' else '/**/' end);
        else
          if(json_part.num = 1) then
            add_to_clob(buf, buf_str, llcheck('"'||escapeString(json_part.get_string)||'"'));
          else
            add_to_clob(buf, buf_str, llcheck('/**/'||json_part.get_string||'/**/'));
          end if;
        end if;
      when 'bool' then
	      if(json_part.get_bool) then
          add_to_clob(buf, buf_str, 'true');
        else
          add_to_clob(buf, buf_str, 'false');
        end if;
      when 'null' then
        add_to_clob(buf, buf_str, 'null');
      when 'array' then
        pretty_print_list(json_list(json_part), spaces, buf, line_length);
        return;
      when 'object' then
        pretty_print(json(json_part), spaces, buf, line_length);
        return;
      else add_to_clob(buf, buf_str, 'unknown type:'|| json_part.get_type);
    end case;
    flush_clob(buf, buf_str);
  end;

/* Clob method end here */

/* Varchar2 method start here */

  procedure ppObj(obj json, indent number, buf in out nocopy varchar2, spaces boolean);

  procedure ppEA(input json_list, indent number, buf in out varchar2, spaces boolean) as
    elem json_value;
    arr json_value_array := input.list_data;
    str varchar2(400);
  begin
    for y in 1 .. arr.count loop
      elem := arr(y);
      if(elem is not null) then
      case elem.get_type
        when 'number' then
          str := '';
          if (elem.get_number < 1 and elem.get_number > 0) then str := '0'; end if;
          if (elem.get_number < 0 and elem.get_number > -1) then
            str := '-0' || substr(to_char(elem.get_number, 'TM9', 'NLS_NUMERIC_CHARACTERS=''.,'''),2);
          else
            str := str || to_char(elem.get_number, 'TM9', 'NLS_NUMERIC_CHARACTERS=''.,''');
          end if;
          buf := buf || llcheck(str);
        when 'string' then
          if(elem.num = 1) then
            buf := buf || llcheck('"'||escapeString(elem.get_string)||'"');
          else
            buf := buf || llcheck('/**/'||elem.get_string||'/**/');
          end if;
        when 'bool' then
          if(elem.get_bool) then
            buf := buf || llcheck('true');
          else
            buf := buf || llcheck('false');
          end if;
        when 'null' then
          buf := buf || llcheck('null');
        when 'array' then
          buf := buf || llcheck('[');
          ppEA(json_list(elem), indent, buf, spaces);
          buf := buf || llcheck(']');
        when 'object' then
          ppObj(json(elem), indent, buf, spaces);
        else buf := buf || llcheck(elem.get_type); /* should never happen */
      end case;
      end if;
      if(y != arr.count) then buf := buf || llcheck(getCommaSep(spaces)); end if;
    end loop;
  end ppEA;

  procedure ppMem(mem json_value, indent number, buf in out nocopy varchar2, spaces boolean) as
    str varchar2(400) := '';
  begin
    buf := buf || llcheck(tab(indent, spaces)) || getMemName(mem, spaces);
    case mem.get_type
      when 'number' then
        if (mem.get_number < 1 and mem.get_number > 0) then str := '0'; end if;
        if (mem.get_number < 0 and mem.get_number > -1) then
          str := '-0' || substr(to_char(mem.get_number, 'TM9', 'NLS_NUMERIC_CHARACTERS=''.,'''),2);
        else
          str := str || to_char(mem.get_number, 'TM9', 'NLS_NUMERIC_CHARACTERS=''.,''');
        end if;
        buf := buf || llcheck(str);
      when 'string' then
        if(mem.num = 1) then
          buf := buf || llcheck('"'||escapeString(mem.get_string)||'"');
        else
          buf := buf || llcheck('/**/'||mem.get_string||'/**/');
        end if;
      when 'bool' then
        if(mem.get_bool) then
          buf := buf || llcheck('true');
        else
          buf := buf || llcheck('false');
        end if;
      when 'null' then
        buf := buf || llcheck('null');
      when 'array' then
        buf := buf || llcheck('[');
        ppEA(json_list(mem), indent, buf, spaces);
        buf := buf || llcheck(']');
      when 'object' then
        ppObj(json(mem), indent, buf, spaces);
      else buf := buf || llcheck(mem.get_type); /* should never happen */
    end case;
  end ppMem;

  procedure ppObj(obj json, indent number, buf in out nocopy varchar2, spaces boolean) as
  begin
    buf := buf || llcheck('{') || newline(spaces);
    for m in 1 .. obj.json_data.count loop
      ppMem(obj.json_data(m), indent+1, buf, spaces);
      if(m != obj.json_data.count) then buf := buf || llcheck(',') || newline(spaces);
      else buf := buf || newline(spaces); end if;
    end loop;
    buf := buf || llcheck(tab(indent, spaces)) || llcheck('}'); -- || chr(13);
  end ppObj;

  function pretty_print(obj json, spaces boolean default true, line_length number default 0) return varchar2 as
    buf varchar2(32767) := '';
  begin
    max_line_len := line_length;
    cur_line_len := 0;
    ppObj(obj, 0, buf, spaces);
    return buf;
  end pretty_print;

  function pretty_print_list(obj json_list, spaces boolean default true, line_length number default 0) return varchar2 as
    buf varchar2(32767);
  begin
    max_line_len := line_length;
    cur_line_len := 0;
    buf := llcheck('[');
    ppEA(obj, 0, buf, spaces);
    buf := buf || llcheck(']');
    return buf;
  end;

  function pretty_print_any(json_part json_value, spaces boolean default true, line_length number default 0) return varchar2 as
    buf varchar2(32767) := '';
  begin
    case json_part.get_type
      when 'number' then
        if (json_part.get_number() < 1 and json_part.get_number() > 0) then buf := buf || '0'; end if;
        if (json_part.get_number() < 0 and json_part.get_number() > -1) then
          buf := buf || '-0';
          buf := buf || substr(to_char(json_part.get_number(), 'TM9', 'NLS_NUMERIC_CHARACTERS=''.,'''),2);
        else
          buf := buf || to_char(json_part.get_number(), 'TM9', 'NLS_NUMERIC_CHARACTERS=''.,''');
        end if;
      when 'string' then
        if(json_part.num = 1) then
          buf := buf || '"'||escapeString(json_part.get_string)||'"';
        else
          buf := buf || '/**/'||json_part.get_string||'/**/';
        end if;
      when 'bool' then
      	if(json_part.get_bool) then buf := 'true'; else buf := 'false'; end if;
      when 'null' then
        buf := 'null';
      when 'array' then
        buf := pretty_print_list(json_list(json_part), spaces, line_length);
      when 'object' then
        buf := pretty_print(json(json_part), spaces, line_length);
      else buf := 'weird error: '|| json_part.get_type;
    end case;
    return buf;
  end;

  procedure dbms_output_clob(my_clob clob, delim varchar2, jsonp varchar2 default null) as
    prev number := 1;
    indx number := 1;
    size_of_nl number := lengthb(delim);
    v_str varchar2(32767);
    amount number := 32767;
  begin
    if(jsonp is not null) then dbms_output.put_line(jsonp||'('); end if;
    while(indx != 0) loop
      --read every line
      indx := dbms_lob.instr(my_clob, delim, prev+1);
 --     dbms_output.put_line(prev || ' to ' || indx);

      if(indx = 0) then
        --emit from prev to end;
        amount := 32767;
 --       dbms_output.put_line(' mycloblen ' || dbms_lob.getlength(my_clob));
        loop
          dbms_lob.read(my_clob, amount, prev, v_str);
          dbms_output.put_line(v_str);
          prev := prev+amount-1;
          exit when prev >= dbms_lob.getlength(my_clob);
        end loop;
      else
        amount := indx - prev;
        if(amount > 32767) then
          amount := 32767;
--          dbms_output.put_line(' mycloblen ' || dbms_lob.getlength(my_clob));
          loop
            dbms_lob.read(my_clob, amount, prev, v_str);
            dbms_output.put_line(v_str);
            prev := prev+amount-1;
            amount := indx - prev;
            exit when prev >= indx - 1;
            if(amount > 32767) then amount := 32767; end if;
          end loop;
          prev := indx + size_of_nl;
        else
          dbms_lob.read(my_clob, amount, prev, v_str);
          dbms_output.put_line(v_str);
          prev := indx + size_of_nl;
        end if;
      end if;

    end loop;
    if(jsonp is not null) then dbms_output.put_line(')'); end if;

/*    while (amount != 0) loop
      indx := dbms_lob.instr(my_clob, delim, prev+1);

--      dbms_output.put_line(prev || ' to ' || indx);
      if(indx = 0) then
        indx := dbms_lob.getlength(my_clob)+1;
      end if;

      if(indx-prev > 32767) then
        indx := prev+32767;
      end if;
--      dbms_output.put_line(prev || ' to ' || indx);
      --substr doesnt work properly on all platforms! (come on oracle - error on Oracle VM for virtualbox)
--        dbms_output.put_line(dbms_lob.substr(my_clob, indx-prev, prev));
      amount := indx-prev;
--        dbms_output.put_line('amount'||amount);
      dbms_lob.read(my_clob, amount, prev, v_str);
      dbms_output.put_line(v_str);
      prev := indx+size_of_nl;
      if(amount = 32767) then prev := prev-size_of_nl-1; end if;
    end loop;
    if(jsonp is not null) then dbms_output.put_line(')'); end if;*/
  end;


/*  procedure dbms_output_clob(my_clob clob, delim varchar2, jsonp varchar2 default null) as
    prev number := 1;
    indx number := 1;
    size_of_nl number := lengthb(delim);
    v_str varchar2(32767);
    amount number;
  begin
    if(jsonp is not null) then dbms_output.put_line(jsonp||'('); end if;
    while (indx != 0) loop
      indx := dbms_lob.instr(my_clob, delim, prev+1);

--      dbms_output.put_line(prev || ' to ' || indx);
      if(indx-prev > 32767) then
        indx := prev+32767;
      end if;
--      dbms_output.put_line(prev || ' to ' || indx);
      --substr doesnt work properly on all platforms! (come on oracle - error on Oracle VM for virtualbox)
      if(indx = 0) then
--        dbms_output.put_line(dbms_lob.substr(my_clob, dbms_lob.getlength(my_clob)-prev+size_of_nl, prev));
        amount := dbms_lob.getlength(my_clob)-prev+size_of_nl;
        dbms_lob.read(my_clob, amount, prev, v_str);
      else
--        dbms_output.put_line(dbms_lob.substr(my_clob, indx-prev, prev));
        amount := indx-prev;
--        dbms_output.put_line('amount'||amount);
        dbms_lob.read(my_clob, amount, prev, v_str);
      end if;
      dbms_output.put_line(v_str);
      prev := indx+size_of_nl;
      if(amount = 32767) then prev := prev-size_of_nl-1; end if;
    end loop;
    if(jsonp is not null) then dbms_output.put_line(')'); end if;
  end;
*/
  procedure htp_output_clob(my_clob clob, jsonp varchar2 default null) as
    /*amount number := 4096;
    pos number := 1;
    len number;
    */
    l_amt    number default 30;
    l_off   number default 1;
    l_str   varchar2(4096);

  begin
    if(jsonp is not null) then htp.prn(jsonp||'('); end if;

    begin
      loop
        dbms_lob.read( my_clob, l_amt, l_off, l_str );

        -- it is vital to use htp.PRN to avoid
        -- spurious line feeds getting added to your
        -- document
        htp.prn( l_str  );
        l_off := l_off+l_amt;
        l_amt := 4096;
      end loop;
    exception
      when no_data_found then NULL;
    end;

    /*
    len := dbms_lob.getlength(my_clob);

    while(pos < len) loop
      htp.prn(dbms_lob.substr(my_clob, amount, pos)); -- should I replace substr with dbms_lob.read?
      --dbms_output.put_line(dbms_lob.substr(my_clob, amount, pos));
      pos := pos + amount;
    end loop;
    */
    if(jsonp is not null) then htp.prn(')'); end if;
  end;

end json_printer;
/

prompt
prompt Creating package body JSON_UTIL_PKG
prompt ===================================
prompt
create or replace package body freedom.json_util_pkg
as
  scanner_exception exception;
  pragma exception_init(scanner_exception, -20100);
  parser_exception exception;
  pragma exception_init(parser_exception, -20101);

  /*

  Purpose:    JSON utilities for PL/SQL

  Remarks:

  Who     Date        Description
  ------  ----------  -------------------------------------
  MBR     30.01.2010  Created

  */


  g_json_null_object             constant varchar2(20) := '{ }';


function get_xml_to_json_stylesheet return varchar2
as
begin

  /*

  Purpose:    return XSLT stylesheet for XML to JSON transformation

  Remarks:    see http://code.google.com/p/xml2json-xslt/

  Who     Date        Description
  ------  ----------  -------------------------------------
  MBR     30.01.2010  Created
  MBR     30.01.2010  Added fix for nulls

  */


  return q'^<?xml version="1.0" encoding="UTF-8"?>
<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
<!--
  Copyright (c) 2006,2008 Doeke Zanstra
  All rights reserved.

  Redistribution and use in source and binary forms, with or without modification,
  are permitted provided that the following conditions are met:

  Redistributions of source code must retain the above copyright notice, this
  list of conditions and the following disclaimer. Redistributions in binary
  form must reproduce the above copyright notice, this list of conditions and the
  following disclaimer in the documentation and/or other materials provided with
  the distribution.

  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
  ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
  IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
  INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
  BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
  LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
  OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
  THE POSSIBILITY OF SUCH DAMAGE.
-->

  <xsl:output indent="no" omit-xml-declaration="yes" method="text" encoding="UTF-8" media-type="text/x-json"/>
        <xsl:strip-space elements="*"/>
  <!--contant-->
  <xsl:variable name="d">0123456789</xsl:variable>

  <!-- ignore document text -->
  <xsl:template match="text()[preceding-sibling::node() or following-sibling::node()]"/>

  <!-- string -->
  <xsl:template match="text()">
    <xsl:call-template name="escape-string">
      <xsl:with-param name="s" select="."/>
    </xsl:call-template>
  </xsl:template>

  <!-- Main template for escaping strings; used by above template and for object-properties
       Responsibilities: placed quotes around string, and chain up to next filter, escape-bs-string -->
  <xsl:template name="escape-string">
    <xsl:param name="s"/>
    <xsl:text>"</xsl:text>
    <xsl:call-template name="escape-bs-string">
      <xsl:with-param name="s" select="$s"/>
    </xsl:call-template>
    <xsl:text>"</xsl:text>
  </xsl:template>

  <!-- Escape the backslash (\) before everything else. -->
  <xsl:template name="escape-bs-string">
    <xsl:param name="s"/>
    <xsl:choose>
      <xsl:when test="contains($s,'\')">
        <xsl:call-template name="escape-quot-string">
          <xsl:with-param name="s" select="concat(substring-before($s,'\'),'\\')"/>
        </xsl:call-template>
        <xsl:call-template name="escape-bs-string">
          <xsl:with-param name="s" select="substring-after($s,'\')"/>
        </xsl:call-template>
      </xsl:when>
      <xsl:otherwise>
        <xsl:call-template name="escape-quot-string">
          <xsl:with-param name="s" select="$s"/>
        </xsl:call-template>
      </xsl:otherwise>
    </xsl:choose>
  </xsl:template>

  <!-- Escape the double quote ("). -->
  <xsl:template name="escape-quot-string">
    <xsl:param name="s"/>
    <xsl:choose>
      <xsl:when test="contains($s,'&quot;')">
        <xsl:call-template name="encode-string">
          <xsl:with-param name="s" select="concat(substring-before($s,'&quot;'),'\&quot;')"/>
        </xsl:call-template>
        <xsl:call-template name="escape-quot-string">
          <xsl:with-param name="s" select="substring-after($s,'&quot;')"/>
        </xsl:call-template>
      </xsl:when>
      <xsl:otherwise>
        <xsl:call-template name="encode-string">
          <xsl:with-param name="s" select="$s"/>
        </xsl:call-template>
      </xsl:otherwise>
    </xsl:choose>
  </xsl:template>

  <!-- Replace tab, line feed and/or carriage return by its matching escape code. Can't escape backslash
       or double quote here, because they don't replace characters (&#x0; becomes \t), but they prefix
       characters (\ becomes \\). Besides, backslash should be seperate anyway, because it should be
       processed first. This function can't do that. -->
  <xsl:template name="encode-string">
    <xsl:param name="s"/>
    <xsl:choose>
      <!-- tab -->
      <xsl:when test="contains($s,'&#x9;')">
        <xsl:call-template name="encode-string">
          <xsl:with-param name="s" select="concat(substring-before($s,'&#x9;'),'\t',substring-after($s,'&#x9;'))"/>
        </xsl:call-template>
      </xsl:when>
      <!-- line feed -->
      <xsl:when test="contains($s,'&#xA;')">
        <xsl:call-template name="encode-string">
          <xsl:with-param name="s" select="concat(substring-before($s,'&#xA;'),'\n',substring-after($s,'&#xA;'))"/>
        </xsl:call-template>
      </xsl:when>
      <!-- carriage return -->
      <xsl:when test="contains($s,'&#xD;')">
        <xsl:call-template name="encode-string">
          <xsl:with-param name="s" select="concat(substring-before($s,'&#xD;'),'\r',substring-after($s,'&#xD;'))"/>
        </xsl:call-template>
      </xsl:when>
      <xsl:otherwise><xsl:value-of select="$s"/></xsl:otherwise>
    </xsl:choose>
  </xsl:template>

  <!-- number (no support for javascript mantissa) -->
  <xsl:template match="text()[not(string(number())='NaN' or
                      (starts-with(.,'0' ) and . != '0' and
not(starts-with(.,'0.' ))) or
                      (starts-with(.,'-0' ) and . != '-0' and
not(starts-with(.,'-0.' )))
                      )]">
    <xsl:value-of select="."/>
  </xsl:template>

  <!-- boolean, case-insensitive -->
  <xsl:template match="text()[translate(.,'TRUE','true')='true']">true</xsl:template>
  <xsl:template match="text()[translate(.,'FALSE','false')='false']">false</xsl:template>

  <!-- object -->
  <xsl:template match="*" name="base">
    <xsl:if test="not(preceding-sibling::*)">{</xsl:if>
    <xsl:call-template name="escape-string">
      <xsl:with-param name="s" select="name()"/>
    </xsl:call-template>
    <xsl:text>:</xsl:text>
    <!-- check type of node -->
    <xsl:choose>
      <!-- null nodes -->
      <xsl:when test="count(child::node())=0">null</xsl:when>
      <!-- other nodes -->
      <xsl:otherwise>
        <xsl:apply-templates select="child::node()"/>
      </xsl:otherwise>
    </xsl:choose>
    <!-- end of type check -->
    <xsl:if test="following-sibling::*">,</xsl:if>
    <xsl:if test="not(following-sibling::*)">}</xsl:if>
  </xsl:template>

  <!-- array -->
  <xsl:template match="*[count(../*[name(../*)=name(.)])=count(../*) and count(../*)&gt;1]">
    <xsl:if test="not(preceding-sibling::*)">[</xsl:if>
    <xsl:choose>
      <xsl:when test="not(child::node())">
        <xsl:text>null</xsl:text>
      </xsl:when>
      <xsl:otherwise>
        <xsl:apply-templates select="child::node()"/>
      </xsl:otherwise>
    </xsl:choose>
    <xsl:if test="following-sibling::*">,</xsl:if>
    <xsl:if test="not(following-sibling::*)">]</xsl:if>
  </xsl:template>

  <!-- convert root element to an anonymous container -->
  <xsl:template match="/">
    <xsl:apply-templates select="node()"/>
  </xsl:template>

</xsl:stylesheet>^';

end get_xml_to_json_stylesheet;


function ref_cursor_to_json (p_ref_cursor in sys_refcursor,
                             p_max_rows in number := null,
                             p_skip_rows in number := null) return json_list
as
  l_ctx         dbms_xmlgen.ctxhandle;
  l_num_rows    pls_integer;
  l_xml         xmltype;
  l_json        xmltype;
  l_returnvalue clob;
begin

  /*

  Purpose:    generate JSON from REF Cursor

  Remarks:

  Who     Date        Description
  ------  ----------  -------------------------------------
  MBR     30.01.2010  Created
  JKR     01.05.2010  Edited to fit in PL/JSON

  */

  l_ctx := dbms_xmlgen.newcontext (p_ref_cursor);

  dbms_xmlgen.setnullhandling (l_ctx, dbms_xmlgen.empty_tag);

  -- for pagination

  if p_max_rows is not null then
    dbms_xmlgen.setmaxrows (l_ctx, p_max_rows);
  end if;

  if p_skip_rows is not null then
    dbms_xmlgen.setskiprows (l_ctx, p_skip_rows);
  end if;

  -- get the XML content
  l_xml := dbms_xmlgen.getxmltype (l_ctx, dbms_xmlgen.none);

  l_num_rows := dbms_xmlgen.getnumrowsprocessed (l_ctx);

  dbms_xmlgen.closecontext (l_ctx);

  close p_ref_cursor;

  if l_num_rows > 0 then
    -- perform the XSL transformation
    l_json := l_xml.transform (xmltype(get_xml_to_json_stylesheet));
    l_returnvalue := l_json.getclobval();
  else
    l_returnvalue := g_json_null_object;
  end if;

  l_returnvalue := dbms_xmlgen.convert (l_returnvalue, dbms_xmlgen.entity_decode);

  if(l_num_rows = 0) then
    return json_list();
  else
    if(l_num_rows = 1) then
      declare ret json_list := json_list();
      begin
        ret.append(
          json(
            json(l_returnvalue).get('ROWSET')
          ).get('ROW')
        );
        return ret;
      end;
    else
      return json_list(json(l_returnvalue).get('ROWSET'));
    end if;
  end if;

exception
  when scanner_exception then
    dbms_output.put('Scanner problem with the following input: ');
    dbms_output.put_line(l_returnvalue);
    raise;
  when parser_exception then
    dbms_output.put('Parser problem with the following input: ');
    dbms_output.put_line(l_returnvalue);
    raise;
  when others then raise;
end ref_cursor_to_json;

function sql_to_json (p_sql in varchar2,
                      p_max_rows in number := null,
                      p_skip_rows in number := null) return json_list
as
  v_cur sys_refcursor;
begin
  open v_cur for p_sql;
  return ref_cursor_to_json(v_cur, p_max_rows, p_skip_rows);

end sql_to_json;


end json_util_pkg;
/

prompt
prompt Creating package body JSON_XML
prompt ==============================
prompt
create or replace package body freedom.json_xml as

  function escapeStr(str varchar2) return varchar2 as
    buf varchar2(32767) := '';
    ch varchar2(4);
  begin
    for i in 1 .. length(str) loop
      ch := substr(str, i, 1);
      case ch
      when '&' then buf := buf || '&amp;';
      when '<' then buf := buf || '&lt;';
      when '>' then buf := buf || '&gt;';
      when '"' then buf := buf || '&quot;';
      else buf := buf || ch;
      end case;
    end loop;
    return buf;
  end escapeStr;

/* Clob methods from printer */
  procedure add_to_clob(buf_lob in out nocopy clob, buf_str in out nocopy varchar2, str varchar2) as
  begin
    if(length(str) > 32767 - length(buf_str)) then
      dbms_lob.append(buf_lob, buf_str);
      buf_str := str;
    else
      buf_str := buf_str || str;
    end if;
  end add_to_clob;

  procedure flush_clob(buf_lob in out nocopy clob, buf_str in out nocopy varchar2) as
  begin
    dbms_lob.append(buf_lob, buf_str);
  end flush_clob;

  procedure toString(obj json_value, tagname in varchar2, xmlstr in out nocopy clob, xmlbuf in out nocopy varchar2) as
    v_obj json;
    v_list json_list;

    v_keys json_list;
    v_value json_value;
    key_str varchar2(4000);
  begin
    if (obj.is_object()) then
      add_to_clob(xmlstr, xmlbuf, '<' || tagname || '>');
      v_obj := json(obj);

      v_keys := v_obj.get_keys();
      for i in 1 .. v_keys.count loop
        v_value := v_obj.get(i);
        key_str := v_keys.get(i).str;

        if(key_str = 'content') then
          if(v_value.is_array()) then
            declare
              v_l json_list := json_list(v_value);
            begin
              for j in 1 .. v_l.count loop
                if(j > 1) then add_to_clob(xmlstr, xmlbuf, chr(13)||chr(10)); end if;
                add_to_clob(xmlstr, xmlbuf, escapeStr(v_l.get(j).to_char()));
              end loop;
            end;
          else
            add_to_clob(xmlstr, xmlbuf, escapeStr(v_value.to_char()));
          end if;
        elsif(v_value.is_array()) then
          declare
            v_l json_list := json_list(v_value);
          begin
            for j in 1 .. v_l.count loop
              v_value := v_l.get(j);
              if(v_value.is_array()) then
                add_to_clob(xmlstr, xmlbuf, '<' || key_str || '>');
                add_to_clob(xmlstr, xmlbuf, escapeStr(v_value.to_char()));
                add_to_clob(xmlstr, xmlbuf, '</' || key_str || '>');
              else
                toString(v_value, key_str, xmlstr, xmlbuf);
              end if;
            end loop;
          end;
        elsif(v_value.is_null() or (v_value.is_string and v_value.get_string = '')) then
          add_to_clob(xmlstr, xmlbuf, '<' || key_str || '/>');
        else
          toString(v_value, key_str, xmlstr, xmlbuf);
        end if;
      end loop;

      add_to_clob(xmlstr, xmlbuf, '</' || tagname || '>');
    elsif (obj.is_array()) then
      v_list := json_list(obj);
      for i in 1 .. v_list.count loop
        v_value := v_list.get(i);
        toString(v_value, nvl(tagname, 'array'), xmlstr, xmlbuf);
      end loop;
    else
      add_to_clob(xmlstr, xmlbuf, '<' || tagname || '>'||escapeStr(obj.to_char())||'</' || tagname || '>');
    end if;
  end toString;

  function json_to_xml(obj json, tagname varchar2 default 'root') return xmltype as
    xmlstr clob := empty_clob();
    xmlbuf varchar2(32767) := '';
    returnValue xmltype;
  begin
    dbms_lob.createtemporary(xmlstr, true);

    toString(obj.to_json_value(), tagname, xmlstr, xmlbuf);

    flush_clob(xmlstr, xmlbuf);
    returnValue := xmltype('<?xml version="1.0"?>'||xmlstr);
    dbms_lob.freetemporary(xmlstr);
    return returnValue;
  end;

end json_xml;
/

prompt
prompt Creating package body PK_BITFINEX
prompt =================================
prompt
create or replace package body freedom.pk_bitfinex is
  
  procedure check_freq 
  is
  begin
     pk_tool.check_freq('bitfinex');
  end;
  
  function number_to_char(a_num number) return varchar2
  is 
  begin
      return rtrim(to_char(a_num, 'fm9990d999'), substr(to_char(0,'fm0D'),-1));
  end;
  
  function query_auth(a_link varchar2, a_req json) return varchar2
  is
      l_handle  varchar2(200);
      l_nonce     varchar2(50) := pk_lock.lock_and_get_seq('SEQ_BITFINEX_API_NONCE',l_handle);
      l_j         json:=a_req;
      --
      l_payload   varchar2(2000);
      l_signature varchar2(2000);
      -- 
      la_headers  pk_http.THeaders := pk_http.g_dummy_headers;
  begin
--      p(a_link);
      
      check_freq;
      l_j.put('nonce',l_nonce);
      -- generating payload (parameters-dictionary -> JSON encode -> base64)
--      p(l_j.to_char);
      l_payload := pk_crypto.base64_encode(l_j.to_char);
--      p('base64: '||l_payload);
--      p('base64_raw: '||utl_raw.cast_to_raw(l_payload));

     
      -- generating signature (signature = HMAC-SHA384(payload, api-secret) as hexadecimal )
      l_signature := pk_crypto.hmac(l_payload,pk_bitfinex.g_api_secret,pk_crypto.g_hmac_sha384);
      -- send (api-key, payload, signature)
      -- These are encoded as HTTP headers named:
      -- -- X-BFX-APIKEY
      -- -- X-BFX-PAYLOAD
      -- -- X-BFX-SIGNATURE
      la_headers('Content-Type'):= 'text/xml; charset=utf-8';
--      la_headers('Content-Length'):= LENGTHB(l_req);
      la_headers('X-BFX-APIKEY'):=pk_bitfinex.g_api_key;
      la_headers('X-BFX-PAYLOAD'):= l_payload;
      la_headers('X-BFX-SIGNATURE') := l_signature;
      return pk_http.request(a_adress => a_link ,aa_headers => la_headers,a_method => 'POST', a_handle =>  l_handle);

  end;
  
  procedure check_status(a_res varchar2)
  is
     j json;
  begin
    if INSTR(a_res,'message') <> 0 then
       j := json(a_res);
       raise_application_error(-20001,j.get('message').get_string);
    end if;
  end;
    
  
  function book(a_code_from varchar2, a_code_to varchar2) return pk_tool.TBookStrArr pipelined
  is
       ret      json;
       jbs      json_list;
       j        json;
       str      pk_tool.TBookStr;
       --
       l_cnt    number;
  begin
    check_freq ;
    -- how much deals per side to return
    select max(p.param_value) into l_cnt from t_system_params p where p.param_code = 'book cnt';
    
    -- if this is pair ltc - btc
    if a_code_to = 'ltc' and a_code_from = 'btc' then
        ret := json(pk_http.request('https://api.bitfinex.com/v1/book/ltcbtc'));
       -- buys
       jbs := json_list(ret.get('bids'));
       if jbs.count > 0 then
         for i in 1..least(jbs.count,nvl(l_cnt,jbs.count)) loop
           j := json(jbs.get(i));
           str.buysell:='buy';
           str.rate:=j.get('price').get_string;
           str.amount:=j.get('amount').get_string;
              pipe row (str);
         end loop;
       end if;
        -- sells
       jbs := json_list(ret.get('asks'));
       if jbs.count > 0 then
         for i in 1..least(jbs.count,nvl(l_cnt,jbs.count)) loop
           j := json(jbs.get(i));
           str.buysell:='sell';
           str.rate:=j.get('price').get_string;
           str.amount:=j.get('amount').get_string;
              pipe row (str);
         end loop;
       end if;
    end if;
    return;
  end;
  
  function balance return pk_tool.TAmountsArr pipelined
  is
      l_req     varchar2(200) := '/v1/balances';
      l_j       json:=json();
      --
      l_res       varchar2(2000);
      l_jres      json_list;
      j           json;
      l_cur       varchar2(20);
      --
      la_bal      pk_tool.TAmounts;
    begin
      -- generating request
      l_j.put('request',l_req);
      
      l_res:=
      query_auth(a_link => 'https://api.bitfinex.com/v1/balances',a_req => l_j);
      
      -- parsing of result
      l_jres := json_list(l_res);
      for i in 1..l_jres.count loop
        j := json(l_jres.get(i));
        if j.get('type').get_string = 'exchange' AND to_number(j.get('amount').get_string) > 0 then
          la_bal.cur :=j.get('currency').get_string;
          la_bal.amount:= to_number(j.get('amount').get_string);
             pipe row(la_bal);
        end if;
      end loop;
      end;
      
    function make_order(a_buysell varchar2, a_cur_from varchar2, a_cur_to varchar2, a_rate number, a_amount number) return number
    is
      l_req     varchar2(200) := '/v1/order/new';
      l_j       json:=json();
      --
      l_res       varchar2(2000);
      l_jres      json;
      j           json;
      l_cur       varchar2(20);
      --
      la_bal      pk_tool.TAmounts;
      -- 
      l_id        number;
      l_cancel_res varchar2(20);
    begin
      -- generating request
      l_j.put('request',l_req);
      l_j.put('symbol',a_cur_to||a_cur_from);
      l_j.put('amount',number_to_char(a_amount));
      l_j.put('price',number_to_char(a_rate));
      l_j.put('exchange','bitfinex');
      l_j.put('side',a_buysell);
      l_j.put('type','exchange limit');
      
      l_res:=
      query_auth(a_link => /*'http://toolsandmills.com/test_req.php'*/'https://api.bitfinex.com'||l_req,a_req => l_j);
      check_status(l_res);
      p(l_res);
      
      -- parsing of result
      l_jres := json(l_res);
      l_id := l_jres.get('order_id').to_char;
      
      -- if this kind of orders should be confirmed immediately, than we check it and cancel it it's not confirmed
      /*
      dbms_lock.sleep(5);
      if pk_bitfinex.get_status_order(l_id) <> 'done' then
        begin
            l_cancel_res:=
            pk_bitfinex.cancel_order(l_id);
            
        exception
          when others then
            -- seems it is done, then ok
            null;
        end;
        if l_cancel_res ='ok' then
          raise_application_error(-20001, 'Order timed out');
        end if;
      end if;
      */
      
      return l_id;
      end;
      
    function cancel_order(a_id number) return varchar2
    is
      l_req     varchar2(200) := '/v1/order/cancel';
      l_j       json:=json();
      --
      l_res       varchar2(2000);
      l_jres      json;
      j           json;
      l_cur       varchar2(20);
      --
      la_bal      pk_tool.TAmounts;
      -- 
      l_id        number;
    begin
      -- generating request
      l_j.put('request',l_req);
      l_j.put('order_id',a_id);
      
      l_res:=
      query_auth(a_link => 'https://api.bitfinex.com'||l_req,a_req => l_j);
--      p(l_res);
      check_status(l_res);
      
      -- parsing of result
--      l_jres := json(l_res);
--      l_id := l_jres.get('order_id').to_char;
      
      return 'ok';
      end;
      
    function get_status_order(a_id number) return varchar2
    is
      l_req     varchar2(200) := '/v1/order/status';
      l_j       json:=json();
      --
      l_res       varchar2(2000);
      l_jres      json;
      j           json;
      l_cur       varchar2(20);
      --
      la_bal      pk_tool.TAmounts;
      -- 
      l_val       varchar2(10);
    begin
      -- generating request
      l_j.put('request',l_req);
      l_j.put('order_id',a_id);
      
      l_res:=
      query_auth(a_link => 'https://api.bitfinex.com'||l_req,a_req => l_j);
--      p(l_res);
      check_status(l_res);
      
      -- parsing of result
      l_jres := json(l_res);
      l_val := l_jres.get('remaining_amount').get_string;
      if l_val = 0 then
          return 'done';
      else
          return l_val||' left';
      end if;
          
   end;
end pk_bitfinex;
/

prompt
prompt Creating package body PK_BTC_E
prompt ==============================
prompt
create or replace package body freedom.pk_btc_e is
  
  procedure check_freq 
  is
     l_cur_time date :=sysdate;
     l_limit    number;
  begin
    pk_tool.check_freq('btc_e');
  end;
  
  procedure check_status(a_res varchar2)
  is
     j json;
  begin
    j := json(a_res);
    if j.get('success').get_number = 0 then
       raise_application_error(-20001,j.get('error').get_string);
    end if;
  end;
  
  function query_auth(a_link varchar2, a_post_parametrs varchar2) return varchar2
  is
      l_handle  varchar2(200);
      l_nonce   varchar2(50) := pk_lock.lock_and_get_seq('seq_btc_e_api_nonce',l_handle);
      l_req     varchar2(1000);
      l_signature varchar2(2000);
      la_headers  pk_http.THeaders := pk_http.g_dummy_headers;
  begin
      check_freq;
      l_req :='nonce='||l_nonce;
      if a_post_parametrs is not null then
        l_req := a_post_parametrs ||'&'|| l_req;
      end if;
      
--      p('link:'||a_link);
--      p('req:'||l_req);
--      p('secret:'||pk_btc_e.g_api_secret);
      
      -- generating signature 
      l_signature := pk_crypto.hmac(l_req,pk_btc_e.g_api_secret,pk_crypto.g_hmac_sha512);
--      p(l_signature);
--      p('api key:'||pk_btc_e.g_api_key);
      -- headers
--      la_headers('Content-Type'):= 'text/xml; charset=utf-8';
      la_headers('Content-type'):= 'application/x-www-form-urlencoded';
      la_headers('Content-Length'):= LENGTHB(l_req);
      la_headers('User-Agent'):= 'Mozilla/4.0';
      la_headers('Key'):=pk_btc_e.g_api_key;
      la_headers('Sign'):= l_signature;
      
      return pk_http.request(a_adress => a_link ,a_msg => l_req, aa_headers => la_headers,a_method => 'POST',a_handle =>  l_handle);
  end;
  
  function book(a_code_from varchar2, a_code_to varchar2) return pk_tool.TBookStrArr pipelined
  is
       ret      json;
       jbs      json_list;
       j_par    json;
       j        json_list;
       str      pk_tool.TBookStr;
       --
       l_cnt    number;
  begin
    check_freq;
    -- how much deals per side to return
    select max(p.param_value) into l_cnt from t_system_params p where p.param_code = 'book cnt';
    -- if this is pair ltc - btc
    if a_code_to = 'ltc' and a_code_from = 'btc' then
        ret := json(pk_http.request('https://btc-e.com/api/2/ltc_btc/depth'));
       -- buys
       jbs := json_list(ret.get('bids'));
       if jbs.count > 0 then
         for i in 1..least(jbs.count,nvl(l_cnt,jbs.count)) loop
           j := json_list(jbs.get(i));
           str.buysell:='buy';
           str.rate:=j.get(1).get_number;
           str.amount:=j.get(2).get_number;
              pipe row (str);
         end loop;
       end if;
        -- sells
       jbs := json_list(ret.get('asks'));
       if jbs.count > 0 then
         for i in 1..least(jbs.count,nvl(l_cnt,jbs.count)) loop
           j := json_list(jbs.get(i));
           str.buysell:='sell';
           str.rate:=j.get(1).get_number;
           str.amount:=j.get(2).get_number;
              pipe row (str);
         end loop;
       end if;
    end if;
    return;
  end;
  
  function balance return pk_tool.TAmountsArr pipelined
  is

      l_req       varchar2(2000);
      l_res       varchar2(32000);
      --
      l_jres      json;
      l_j         json;
      l_keys      json_list;
      j           json;
      --
      la_bal      pk_tool.TAmounts;
    begin
      -- generating request
      l_req:='method='||'getInfo';

      l_res:=    
      query_auth(a_link => 'https://btc-e.com/tapi/'/*'toolsandmills.com/test_req.php'*/,a_post_parametrs => l_req);
        
      p(        l_res    );    
      -- parsing of result
      l_jres := json(l_res);
      j := json(l_jres.get('return'));
      l_j:= json(j.get('funds'));
      l_keys := l_j.get_keys;
      for i in 1..l_keys.count loop
        la_bal.cur := l_keys.get(i).get_string;
        la_bal.amount := l_j.get(la_bal.cur).get_number;
        la_bal.cur := lower(la_bal.cur);
        
        if la_bal.amount > 0 then
           pipe row(la_bal);
        end if;
      end loop;
    end;  
    
    function make_order(a_buysell varchar2, a_cur_from varchar2, a_cur_to varchar2, a_rate number, a_amount number) return number
    is
      l_req       varchar2(2000);
      l_res       varchar2(32000);
      --
      l_jres      json;
      l_j         json;
      l_keys      json_list;
      j           json;
      --
      la_bal      pk_tool.TAmounts;
    begin
      -- generating request
      l_req:='method='||'Trade&pair='||a_cur_to||'_'||a_cur_from||'&type='||a_buysell||'&rate='||pk_tool.number_to_char(a_rate)||'&amount='||pk_tool.number_to_char(a_amount);

      l_res:=    
      query_auth(a_link => 'https://btc-e.com/tapi/'/*'toolsandmills.com/test_req.php'*/,a_post_parametrs => l_req);
        
      p(        l_res    );    
      check_status(l_res);
      -- parsing of result
      l_jres := json(l_res);
      j := json(l_jres.get('return'));
      return j.get('order_id').get_number;      
    end;  
    
    function cancel_order(a_id number) return varchar2
    is
        l_req       varchar2(2000);
        l_res       varchar2(32000);
    begin
        l_req:= 'method=CancelOrder&order_id='||a_id;
        l_res:=    
        query_auth(a_link => 'https://btc-e.com/tapi/'/*'toolsandmills.com/test_req.php'*/,a_post_parametrs => l_req);
        p(        l_res    );    
        check_status(l_res);
        return 'ok';
    end;
    
end pk_btc_e;
/

prompt
prompt Creating package body PK_BTER
prompt =============================
prompt
create or replace package body freedom.pk_bter is
 
  procedure check_freq 
  is
  begin
    pk_tool.check_freq('bter');
  end;
  
  function query_auth(a_link varchar2, a_params varchar2 default null) return varchar2
  is
     l_handle  varchar2(200);
     l_nonce   varchar2(50) := pk_lock.lock_and_get_seq('SEQ_BTER_API_NONCE',l_handle);
     l_req     varchar2(2000);
     l_signature varchar2(2000);
     la_headers  pk_http.THeaders := pk_http.g_dummy_headers;
  begin
     check_freq;
     p(a_link);
     -- generating request
     if a_params is null then
        l_req :='nonce='||l_nonce;
     else
        l_req :=a_params||'&nonce='||l_nonce;
     end if;
     l_req := CONVERT(l_req, 'AL32UTF8', 'UTF8');
     p(l_req);
--     l_req:=pk_crypto.encode_url(l_req,'utf8');
--     p('after urlencode:'|| l_req);
     -- generating signature 
     l_signature := pk_crypto.hmac(l_req,pk_bter.g_api_secret,pk_crypto.g_hmac_sha512);
     -- headers
     la_headers('Accept-Charset'):= 'utf-8';
--     la_headers('Content-Type'):= 'text/html;charset=utf-8';
     la_headers('Content-type'):= 'application/x-www-form-urlencoded';
     la_headers('Content-Length'):= LENGTHB(l_req);
     la_headers('User-Agent'):= 'Mozilla/4.0';
     la_headers('KEY'):=pk_bter.g_api_key;
     la_headers('SIGN'):= l_signature;
     
     --l_req:=CONVERT(l_req, 'AL32UTF8', 'ISO-8859-1');
     
     return pk_http.request(a_adress => a_link, a_msg => l_req, aa_headers => la_headers,a_method => 'POST', a_handle => l_handle);     
  end;
  
  procedure check_status(a_res varchar2)
  is
     j json;
  begin
    j := json(a_res);
    raise_application_error(-20001,j.get('message').get_string);
  end;

  function book(a_code_from varchar2, a_code_to varchar2) return pk_tool.TBookStrArr pipelined
  is
       ret      json;
       jbs      json_list;
       j        json_list;
       str      pk_tool.TBookStr;
       --
       l_cnt    number;
  begin
    check_freq ;
    -- how much deals per side to return
    select max(p.param_value) into l_cnt from t_system_params p where p.param_code = 'book cnt';
    -- if this is pair ltc - btc
    if a_code_to = 'ltc' and a_code_from = 'btc' then
        ret := json(pk_http.request('https://bter.com/api/1/depth/ltc_btc'));
       -- buys
       jbs := json_list(ret.get('bids'));
       if jbs.count > 0 then
         for i in 1..least(jbs.count,nvl(l_cnt,jbs.count)) loop
           j := json_list(jbs.get(i));
           str.buysell:='buy';
           str.rate:=j.get(1).get_number;
           str.amount:=j.get(2).get_number;
              pipe row (str);
         end loop;
       end if;
        -- sells
       jbs := json_list(ret.get('asks'));
       if jbs.count > 0 then
         for i in reverse jbs.count-nvl(l_cnt,0)..jbs.count loop
           j := json_list(jbs.get(i));
           str.buysell:='sell';
           str.rate:=j.get(1).get_number;
           str.amount:=j.get(2).get_number;
              pipe row (str);
         end loop;
       end if;
    end if;
    return;
  end;
  
  
  function balance return pk_tool.TAmountsArr pipelined
  is
     l_res       varchar2(2000);
     --
     l_jres      json;
     l_j         json;
     l_keys      json_list;
     -- 
     la_bal      pk_tool.TAmounts;
  begin
     l_res:=
     query_auth('https://bter.com/api/1/private/getfunds');
     
     p(l_res);

     -- parsing of result
     l_jres := json(l_res);
     l_j := json(l_jres.get('available_funds'));
     l_keys := l_j.get_keys;

     for i in 1..l_keys.count loop
       la_bal.cur := l_keys.get(i).get_string;
       la_bal.amount := to_number(l_j.get(la_bal.cur).get_string);
       la_bal.cur := lower(la_bal.cur);
       
       if la_bal.amount > 0 then
           pipe row(la_bal);
       end if;
     end loop;

  end;
      
  -- making orders
  function make_order(a_buysell varchar2, a_cur_from varchar2, a_cur_to varchar2, a_rate number, a_amount number) return number
  is
     l_res       varchar2(32000);
     --
     j           json;
     l_order_id  number;
  begin
     l_res:=
     pk_bter.query_auth('https://bter.com/api/1/private/placeorder','type='||a_buysell||'&rate='||a_rate||'&amount='||a_amount||'&pair='||a_cur_to||'_'||a_cur_from);
     p(l_res);
     j:= json(l_res);
     l_order_id := j.get('order_id').get_number;
     
     return l_order_id;
  end;
  
   -- order info
  function get_status_order(a_id number) return varchar2
  is
      l_res       varchar2(32000);
      --
      j           json;
      jo          json;
  begin
      l_res:=
       pk_bter.query_auth(/*'http://toolsandmills.com/test_req.php'*/'https://bter.com/api/1/private/getorder','order id='||a_id);
       p(l_res);
       j:= json(l_res);
       jo:= json(j.get('order'));
       return jo.get('status').get_string;
  end;
          
  -- cancelation of order
  function cancel_order(a_id number) return varchar2
  is
      l_res       varchar2(32000);
      --
      j           json;
      jo          json;
  begin
      l_res:=
       pk_bter.query_auth('https://bter.com/api/1/private/cancelorder','order_id='||a_id);
       p(l_res);
       j:= json(l_res);
       jo:= json(j.get('order'));
       return jo.get('status').get_string;
  end;

end pk_bter;
/

prompt
prompt Creating package body PK_COINS_E
prompt ================================
prompt
create or replace package body freedom.pk_coins_e is
 
  procedure check_freq 
  is
     l_cur_time date :=sysdate;
     l_limit    number;
  begin
    pk_tool.check_freq('coins_e');
  end;
  
  function query_auth(a_link varchar2, a_post_parametrs varchar2) return varchar2
  is
      l_handle  varchar2(200);
      l_nonce   varchar2(50) := pk_lock.lock_and_get_seq('seq_coins_e_api_nonce',l_handle);
      l_req     varchar2(1000);
      l_signature varchar2(2000);
      la_headers  pk_http.THeaders := pk_http.g_dummy_headers;
  begin
      check_freq;
      l_req :='nonce='||l_nonce;
      if a_post_parametrs is not null then
        l_req := a_post_parametrs ||'&'|| l_req;
      end if;
      
--      p('link:'||a_link);
--      p('req:'||l_req);
      
      -- generating signature 
      l_signature := pk_crypto.hmac(l_req,pk_coins_e.g_api_secret,pk_crypto.g_hmac_sha512);
      -- headers
      la_headers('Content-Type'):= 'text/xml; charset=utf-8';
      la_headers('Content-Length'):= LENGTH(l_req);
      la_headers('User-Agent'):= 'Mozilla/4.0';
      la_headers('key'):=pk_coins_e.g_api_key;
      la_headers('sign'):= l_signature;
      
      return   pk_http.request(a_adress => a_link ,a_msg => l_req, aa_headers => la_headers,a_method => 'POST', a_handle => l_handle );
  end;
  
  procedure check_status(a_res varchar2) 
  is
     j json;
  begin
     j := json(a_res);
     if NOT j.get('status').get_bool then
        raise_application_error(-20001,j.get('message').get_string);
     end if;
  end;

  function book(a_code_from varchar2, a_code_to varchar2) return pk_tool.TBookStrArr pipelined
  is
       ret      json;
       jbs      json_list;
       j_par    json;
       j        json;
       str      pk_tool.TBookStr;
       --
       l_cnt    number;
  begin
    check_freq;
    -- how much deals per side to return
    select max(p.param_value) into l_cnt from t_system_params p where p.param_code = 'book cnt';
    -- if this is pair ltc - btc
    if a_code_to = 'ltc' and a_code_from = 'btc' then
        ret := json(pk_http.request('https://www.coins-e.com/api/v2/market/LTC_BTC/depth/'));
       -- buys
       j_par := json(ret.get('marketdepth'));
       jbs := json_list(j_par.get('bids'));
       if jbs.count > 0 then
         for i in 1..least(jbs.count,nvl(l_cnt,jbs.count)) loop
           j := json(jbs.get(i));
           str.buysell:='buy';
           str.rate:=j.get('r').get_string;
           str.amount:=j.get('cq').get_string;
              pipe row (str);
         end loop;
       end if;
        -- sells
       j_par := json(ret.get('marketdepth'));
       jbs := json_list(j_par.get('asks'));
       if jbs.count > 0 then
         for i in 1..least(jbs.count,nvl(l_cnt,jbs.count)) loop
           j := json(jbs.get(i));
           str.buysell:='sell';
           str.rate:=j.get('r').get_string;
           str.amount:=j.get('cq').get_string;
              pipe row (str);
         end loop;
       end if;
    end if;
    return;
  end;
  
  function balance return pk_tool.TAmountsArr pipelined
  is

      l_req     varchar2(2000);
      l_res       varchar2(32000);
      --
      l_jres      json;
      l_j         json;
      l_keys      json_list;
      j           json;
      --
      la_bal      pk_tool.TAmounts;
    begin
      -- generating request
      l_req:='method='||'getwallets';

      l_res:=    
      query_auth(a_link => 'https://www.coins-e.com/api/v2/wallet/all/',a_post_parametrs => l_req);
      --p(        l_res    );    
      -- parsing of result
      l_jres := json(l_res);
      
      l_j := json(l_jres.get('wallets'));
      l_keys := l_j.get_keys;
      for i in 1..l_keys.count loop
        la_bal.cur := l_keys.get(i).get_string;
        j:= json(l_j.get(la_bal.cur));
        la_bal.amount := to_number(j.get('a').get_string);
        la_bal.cur := lower(la_bal.cur);
        
        if la_bal.amount > 0 then
           pipe row(la_bal);
        end if;
      end loop;
    end;       
    
    function make_order(a_buysell varchar2, a_cur_from varchar2, a_cur_to varchar2, a_rate number, a_amount number) return varchar2
    is 
      l_post_string  varchar2(200):='method=neworder&order_type='||a_buysell||'&rate='||a_rate||'&quantity='||a_amount;
      l_res         varchar2(32000);
        --
      l_jres      json;
      l_j         json;
      l_jv        json_value;
    begin
       l_res := query_auth(a_link => 'https://www.coins-e.com/api/v2/market/'||UPPER(a_cur_to)||'_'||UPPER(a_cur_from)||'/', a_post_parametrs => l_post_string);
       check_status(l_res);
       l_jres :=json(l_res);
       l_j := json(l_jres.get('order').to_char);
       l_jv := l_j.get('id');
       
       return l_jv.get_string;      
    end;
    
    function cancel_order(a_id varchar2,a_cur_from varchar2, a_cur_to varchar2) return varchar2
    is
      l_post_string  varchar2(200):='method=cancelorder&order_id='||a_id;
      l_res         varchar2(32000);
        --
      l_jres      json;
      l_j         json;
      l_jv        json_value;
    begin
       l_res := query_auth(a_link => 'https://www.coins-e.com/api/v2/market/'||UPPER(a_cur_to)||'_'||UPPER(a_cur_from)||'/', a_post_parametrs => l_post_string);
       check_status(l_res);
      
       return 'ok';      
    end;    

end pk_coins_e;
/

prompt
prompt Creating package body PK_CRYPTO
prompt ===============================
prompt
create or replace package body freedom.pk_crypto is

    function hmac(a_input_string varchar2, a_key varchar2, a_algo varchar2) return varchar2
    is
    language java 
    name 'HMAC.hmacDigest(java.lang.String, java.lang.String, java.lang.String) return java.lang.String';
    
     function base64_encode_j(a_msg varchar2) return varchar2
    is
    language java
    name 'Base64.encode(java.lang.String) return java.lang.String';
    
    function base64_encode(a_msg varchar2) return varchar2
    is
    begin
      return TRANSLATE (base64_encode_j(a_msg), 'x'||CHR(10)||CHR(13), 'x');

    end;
    
    function sha2_hash(a_msg varchar2) return varchar2
    is
    language java
    name 'SHA2Hash.get_hash(java.lang.String) return java.lang.String';

end pk_crypto;
/

prompt
prompt Creating package body PK_CRYPTO_TRADE
prompt =====================================
prompt
create or replace package body freedom.pk_crypto_trade is

  procedure check_freq 
  is
  begin
     pk_tool.check_freq('crypto_trade');
  end;
  
  procedure check_status(a_res varchar2) 
  is
     j json;
  begin
     j := json(a_res);
     if j.get('status').get_string = 'error' then
        raise_application_error(-20001,j.get('error').get_string);
     end if;
  end;
  
  function query_auth(a_link varchar2, a_post_parametrs varchar2 default null) return varchar2
  is
      l_handle  varchar2(200);
      l_nonce   varchar2(50) := pk_lock.lock_and_get_seq('seq_crypto_tr_api_nonce',l_handle);
      l_req     varchar2(1000);
      l_signature varchar2(2000);
      la_headers  pk_http.THeaders := pk_http.g_dummy_headers;
  begin
      check_freq;
      l_req :='nonce='||l_nonce;
      if a_post_parametrs is not null then
        l_req := a_post_parametrs ||'&'|| l_req;
      end if;
      
--      p('link:'||a_link);
--      p('req:'||l_req);
      
      -- generating signature 
      l_signature := pk_crypto.hmac(l_req,pk_crypto_trade.g_api_secret,pk_crypto.g_hmac_sha512);
      -- headers
--      la_headers('Content-Type'):= 'text/xml; charset=utf-8';
      la_headers('Content-type'):= 'application/x-www-form-urlencoded';
      la_headers('Content-Length'):= LENGTH(l_req);
      la_headers('User-Agent'):= 'Mozilla/18.0';
      la_headers('AuthKey'):=pk_crypto_trade.g_api_key;
      la_headers('AuthSign'):= l_signature;
      
      return
         pk_http.request(a_adress => a_link ,a_msg => l_req, aa_headers => la_headers,a_method => 'POST',a_handle =>  l_handle);
  end;
  
  function book(a_code_from varchar2, a_code_to varchar2) return pk_tool.TBookStrArr pipelined
  is
       ret      json;
       jbs      json_list;
       j        json_list;
       str      pk_tool.TBookStr;
       --
       l_cnt    number;
  begin
    check_freq ;
    -- how much deals per side to return
    select max(p.param_value) into l_cnt from t_system_params p where p.param_code = 'book cnt';
    
    -- if this is pair ltc - btc
    if a_code_to = 'ltc' and a_code_from = 'btc' then
        ret := json(pk_http.request('https://crypto-trade.com/api/1/depth/ltc_btc'));
        ret.print;
       -- buys
       jbs := json_list(ret.get('bids'));
       if jbs.count > 0 then
         for i in 1..least(jbs.count,nvl(l_cnt,jbs.count)) loop
           j := json_list(jbs.get(i));
           str.buysell:='buy';
           str.rate:=j.get(1).get_string;
           str.amount:=j.get(2).get_string;
              pipe row (str);
         end loop;
       end if;
        -- sells
       jbs := json_list(ret.get('asks'));
       if jbs.count > 0 then
         for i in 1..least(jbs.count,nvl(l_cnt,jbs.count)) loop
           j := json_list(jbs.get(i));
           str.buysell:='sell';
           str.rate:=j.get(1).get_string;
           str.amount:=j.get(2).get_string;
              pipe row (str);
         end loop;
       end if;
    end if;
    return;
  end;
  
  function balance return pk_tool.TAmountsArr pipelined
  is

      l_req     varchar2(2000);
      l_res       varchar2(32000);
      --
      l_jres      json;
      l_j         json;
      l_j2        json;
      l_keys      json_list;
      j           json;
      --
      la_bal      pk_tool.TAmounts;
    begin

      l_res:=    
      query_auth(a_link => 'https://crypto-trade.com/api/1/private/getinfo');
--      p(        l_res    );    
      -- parsing of result
      l_jres := json(l_res);
      
      l_j2 := json(l_jres.get('data'));
      l_j  := json(l_j2.get('funds'));
      
      l_keys := l_j.get_keys;
      for i in 1..l_keys.count loop
        la_bal.cur := l_keys.get(i).get_string;
        la_bal.amount := to_number(l_j.get(la_bal.cur).get_string);
        la_bal.cur := lower(la_bal.cur);
        
        if la_bal.amount > 0 then
           pipe row(la_bal);
        end if;
      end loop;
    end;       
    
    function make_order(a_buysell varchar2, a_cur_from varchar2, a_cur_to varchar2, a_rate number, a_amount number) return number
    is 
      l_post_string  varchar2(200):='pair='||a_cur_to||'_'||a_cur_from||'&type='||initcap(a_buysell)||'&rate='||a_rate||'&amount='||round(a_amount,7);
      l_res         varchar2(32000);
        --
      l_jres      json;
      l_j         json;
      l_jv        json_value;
    begin
       l_res := query_auth(a_link => 'https://crypto-trade.com/api/1/private/trade', a_post_parametrs => l_post_string);
       check_status(l_res);
       -- debuging
       pk_tool.log('CT mo:'||l_res);
--        p(l_res);
       l_jres :=json(l_res);
       l_j := json(l_jres.get('data').to_char);
       l_jv := l_j.get('order_id');
       
       return l_jv.get_string;      
    end;
    
    function cancel_order(a_id number) return varchar2
    is
      l_post_string  varchar2(200):='orderid='||a_id;
      l_res         varchar2(32000);
        --
      l_jres      json;
      l_j         json;
      l_jv        json_value;
    begin
       l_res := query_auth(a_link => 'https://crypto-trade.com/api/1/private/cancelorder', a_post_parametrs => l_post_string);
       check_status(l_res);
      
       return 'ok';      
    end;    
  
end pk_crypto_trade;
/

prompt
prompt Creating package body PK_HTTP
prompt =============================
prompt
create or replace package body freedom.pk_http is
 
  function request(a_adress varchar2,aa_headers THeaders DEFAULT g_dummy_headers, a_msg varchar2 DEFAULT NULL, a_method varchar2 DEFAULT 'GET', a_handle varchar2 DEFAULT null) 
  return varchar2
  is
         l_http_request   UTL_HTTP.req;
         l_http_response  UTL_HTTP.resp;
         l_text           VARCHAR2(32767);
  begin
         -- Make a HTTP request and get the response.
        l_http_request  := UTL_HTTP.begin_request(a_adress, method => a_method,http_version => UTL_HTTP.HTTP_VERSION_1_1 );
        -- Put some headers
        if aa_headers.count > 0 then
          declare
               l_ind varchar2(100) := aa_headers.first();
          begin
               while l_ind IS NOT NULL LOOP
                     UTL_HTTP.set_header(l_http_request, l_ind, aa_headers(l_ind));
                     l_ind := aa_headers.NEXT(l_ind);
                 end loop;
            end;
        end if;
        -- write some measeage
        if a_msg is not null then
           utl_http.write_text(l_http_request, a_msg);
          end if;
          
        l_http_response := UTL_HTTP.get_response(l_http_request);
        if a_handle is not null then pk_lock.release_seq(a_handle); end if;  

        -- Loop through the response.
        /*
        declare
           l_name varchar2(20);
           l_value varchar2(200);
        begin
          FOR i IN 1 .. Utl_Http.get_header_count (r => l_http_response)
           LOOP
              Utl_Http.get_header (r => l_http_response, n => i, NAME => l_name, VALUE => l_value);
              DBMS_OUTPUT.put_line (l_name || ': ' || l_value);
           END LOOP;
        end;
        */
   
        UTL_HTTP.read_text(l_http_response, l_text, 32766);
        UTL_HTTP.end_response(l_http_response);
        RETURN l_text;
      EXCEPTION
        WHEN OTHERS THEN
          UTL_HTTP.end_response(l_http_response);
          RAISE;
  end;
begin
  -- Initialization
  UTL_HTTP.set_wallet('file:'||'G:\arbitrage\crts', 'Fuckoff23');
  UTL_HTTP.set_transfer_timeout(10);
end pk_http;
/

prompt
prompt Creating package body PK_LOCK
prompt =============================
prompt
create or replace package body freedom.pk_lock is

 function lock_and_get_seq(a_seq_name varchar2, a_handle OUT varchar2) return number
 is
      l_res number;
      l_seq number;
 begin
      select h.handle into a_handle from t_lock_handles h where h.seq_name = UPPER(a_seq_name);
      l_res:=
      dbms_lock.request(lockhandle => a_handle,timeout => 10);
  --    0 - success
  --    1 - timeout
  --    2 - deadlock
  --    3 - parameter error
  --    4 - already own lock specified by 'id' or 'lockhandle'
  --    5 - illegal lockhandle
      case l_res
        when 0 then null; 
        when 1 then raise_application_error(-20001, 'timeout');
        when 2 then raise_application_error(-20001, 'deadlock');
        when 3 then raise_application_error(-20001, 'parameter error');
        when 4 then raise_application_error(-20001, 'already own lock specified by ''id'' or ''lockhandle''');
        when 5 then raise_application_error(-20001, 'illegal lockhandle');
      end case;
      
      execute immediate 'begin :seq := '||a_seq_name||'.nextval; end;' USING OUT l_seq;
      return l_seq;      
   end;
   
   function release_seq(a_handle varchar2, a_req varchar2) return varchar2
   is
        l_res number;
   begin
        l_res:=
        dbms_lock.release(a_handle);
        return a_req;
     end;
     
   procedure release_seq(a_handle varchar2) 
   is
        l_res number;
   begin
        l_res:=
        dbms_lock.release(a_handle);
   end;

end pk_lock;
/

prompt
prompt Creating package body PK_RISK_ARBITRAGE
prompt =======================================
prompt
create or replace package body freedom.pk_risk_arbitrage is

-- Private section
  function deal_cur_from(a_buy_sell varchar2) return varchar2
  is
  begin
    return
    case a_buy_sell 
      when 'buy' then 'btc'
        when 'sell' then 'ltc'
    end;
    
  end;
  function deal_cur_to(a_buy_sell varchar2) return varchar2
  is
  begin
    return
    case a_buy_sell 
      when 'buy' then 'ltc'
        when 'sell' then 'btc'
    end;
    
  end;
  --
  procedure open_oposit_deal(la_opened_deal t_risky_deals%rowtype)
  is
    l_profit_rate       number;
    l_pf                number := 0.1;
    l_market_fee        number;
  begin
    --
    select/*+ RESULT_CACHE */ m.fee into l_market_fee from t_market m where m.id = la_opened_deal.id_market;                     
    --
    if la_opened_deal.deal_type = 'buy' then
       l_profit_rate := la_opened_deal.rate * (1 + l_pf) * (1 + 2*l_market_fee/100);
    else
       l_profit_rate := la_opened_deal.rate * (1 - l_pf) * (1 - 2*l_market_fee/100);
    end if;
-- 
    -- calling web api
    insert into t_risky_deals_closed
    values(la_opened_deal.id_deal, null, null, la_opened_deal.id_market, sysdate, l_profit_rate, la_opened_deal.ordered_amount, 'new',null,la_opened_deal.deal_type);
    --
    if la_opened_deal.deal_type = 'buy' then
       update t_risk_market_balance b
       set b.current_balance = b.current_balance-la_opened_deal.ordered_amount
       where b.id_market = la_opened_deal.id_market
       and   b.cur_code = 'ltc';
    else
       
       --
       update t_risk_market_balance b
       set b.current_balance = b.current_balance-(1+l_market_fee/100)*la_opened_deal.ordered_amount*l_profit_rate
       where b.id_market = la_opened_deal.id_market
       and   b.cur_code = 'btc';
    end if;
    commit;
  end;

  procedure open_deals(a_id_load number, a_buy_sell varchar2 default 'buy')
  is
    l_risk        number;

    cursor c_am(a_id_market number, a_cur varchar2) is
       select  b.current_balance, b.init_balance
        from t_risk_market_balance b
        where b.id_market = a_id_market
        and   b.cur_code = a_cur;
      
    l_seeking_type       varchar2(10) := case a_buy_sell when 'buy' then 'sell' when 'sell' then 'buy' end;
    la_market_amounts    c_am%rowtype;
    l_market_fee  number;
    l_deal_am     number;
    l_deal_min    number;
--
    l_sh_dim_cnt  number;
    l_sh_dim      number;
    l_sh_lng      number;
    l_sh_X        number;
    l_sh_R        number;
    l_sh_d2       number;
    l_sh_low      number;
    l_sh_high     number;
     
  begin
    -- we take only most posible deals
--    select p.param_value into l_min_dif from t_system_params p where p.param_code = 'min_dif';
    -- amount per deal for every market in %/100
    select p.param_value into l_risk from t_system_params p where p.param_code = 'risk_per_deal';
    -- shuhart chain length
    select p.param_value into l_sh_lng from t_system_params p where p.param_code = 'shuhart_length';    
    /* most sensitive place */
    /** Shuhart */
    -- check if the dimension of a group is a constant (should be 1)
    
    select count(distinct t_cnts.cnt) as const, min(t_cnts.cnt) as dim
    into l_sh_dim_cnt, l_sh_dim
    from (
          select count(distinct h.id_market) as cnt
              from   t_deals_history h
              where  h.id_load between a_id_load-l_sh_lng and a_id_load
                     and h.buy_sell = l_seeking_type
              group by h.id_load
              ) t_cnts;

       
     if l_sh_dim_cnt <> 1 or l_sh_dim <= 1 then return; end if;
     -- well, we passed the check
     -- now we are calculating the average of average and R
     with t_groups as (
                        select h.id_load, h.id_market, min(h.rate) as rt
                        from   t_deals_history h
                        where  h.id_load between a_id_load-l_sh_lng and a_id_load
                               and h.buy_sell = l_seeking_type
                        group by h.id_load, h.id_market

                       )
      select avg(t_avgs.X) as X_av, avg(t_avgs.R) as R_av
      into l_sh_X,l_sh_R
      from (                 
            select avg(g.rt) as X, max(g.rt) - min(g.rt) as R
            from t_groups g           
            group by g.id_load      
            ) t_avgs    ;
     
 
      -- and we have to know the coefficient of our group dimension 
      begin
        select g.d2
        into l_sh_d2
        from t_shuhart_groups g
        where g.n = l_sh_dim;
      exception
        when no_data_found then
                p('error of getting d2 for dim = '||l_sh_dim);
                RAISE;
      end;
      
      -- so what the lowest rate for normal process
       l_sh_low := l_sh_X - 3*l_sh_R/l_sh_d2;
       l_sh_high := l_sh_X + 3*l_sh_R/l_sh_d2;
      
       for l_deal in (
                      select *
                        from t_deals_history h
                       where h.id_load = a_id_load
                         and h.buy_sell = l_seeking_type
                         and
                         (
                            ( -- case of too cheap deals and buying strategy
                              l_seeking_type = 'sell'
                         and
                              rate < l_sh_low
                            -- we don't take deals with rates higher then we already bought
                         and not exists   (select 'x'
                                                from t_risky_deals d
                                               where d.id_market = h.id_market
                                                 and d.rate <= h.rate
                                                 and d.state NOT IN ('done','spoiled')) 
                         -- each market can provide only one deal
                         and h.rate = (select min(h_in.rate) 
                                       from t_deals_history h_in 
                                       where h_in.id_load = h.id_load and 
                                             h_in.buy_sell = 'sell' and 
                                             h_in.id_market=h.id_market))
                              OR
                              ( -- case of too high rates and selling strategy
                                l_seeking_type = 'buy'
                                --                                
                         and   rate > l_sh_high
                            -- we don't take deals with rates lower then we already sold
                         and not exists   (select 'x'
                                                from t_risky_deals d
                                               where d.id_market = h.id_market
                                                 and d.rate >= h.rate
                                                 and d.state NOT IN ('done','spoiled')) 
                         -- each market can provide only one deal
                         and h.rate = (select max(h_in.rate) 
                                       from t_deals_history h_in 
                                       where h_in.id_load = h.id_load and 
                                             h_in.buy_sell = 'buy' and 
                                             h_in.id_market=h.id_market)
                              )
                                                                                          
                         )                                             
                                             
                                             
                         -- take profit after 17.01.2014
                         and h.dt < TO_DATE('17.01.2014','DD.MM.YYYY')
                       )
        loop

        -- getting market amount
        la_market_amounts := null;
        if l_seeking_type = 'sell' then
          open c_am(l_deal.id_market,l_deal.cur_from);
          fetch c_am into la_market_amounts;
          close c_am;         
        
          l_deal_am:= least(l_deal.amount,l_risk*la_market_amounts.init_balance/l_deal.rate,la_market_amounts.current_balance/l_deal.rate);
        else
          open c_am(l_deal.id_market,l_deal.cur_to);
          fetch c_am into la_market_amounts;
          close c_am;         
        
          l_deal_am:= least(l_deal.amount,l_risk*la_market_amounts.init_balance,la_market_amounts.current_balance);
        end if;
        
        -- open deals higher then minimum
        select/*+ RESULT_CACHE */ NVL(min_val,0) into l_deal_min from t_market_commision c where c.id_market = l_deal.id_market and c.cur_code = l_deal.cur_to;
        if l_deal_am >= l_deal_min then 
            -- opening the deal
            -- calling web api
            insert into t_risky_deals d
            values(l_deal.id_load, l_deal.id_market, l_deal.id, l_deal.dt, l_deal_am, 'new', l_deal.rate, a_buy_sell);
            -- debug
            /*
            if l_deal.id_market = 1 then
              p('deal = '||l_deal.id||' deal am = '||l_deal.amount||' m init b = '||la_market_amounts.init_balance||' m cur b = '||la_market_amounts.current_balance);
              p('l_deal_am = '||l_deal_am||' l_deal_min = '||l_deal_min);
            end if;
            */
            --
            -- updating balance
            -- -- market fees
            select/*+ RESULT_CACHE */ m.fee into l_market_fee from t_market m where m.id = l_deal.id_market;                     
            --
            if l_seeking_type = 'sell' then
              update t_risk_market_balance b
              set b.current_balance = b.current_balance-(1+l_market_fee/100)*l_deal_am*l_deal.rate 
              where b.id_market = l_deal.id_market
              and   b.cur_code = l_deal.cur_from;
            else
              update t_risk_market_balance b
              set b.current_balance = b.current_balance-l_deal_am
              where b.id_market = l_deal.id_market
              and   b.cur_code = l_deal.cur_to;
            end if;
           
            commit;
         end if;
    end loop;
  end;

---------------------------------------------------------------------------- 
------------------------------ Public interface ----------------------------
----------------------------------------------------------------------------
  procedure  process_deals(a_id_load number)
  is
     l_id_load      number := a_id_load;
     l_market_fee   number;
     -- testing var
     l_deal_am      number;
     l_load_dt      date;
  begin
    -- geting next load_id 
    if a_id_load is null then
        select max(h.id_load)
        into l_id_load
        from t_deals_history h;
    end if;
    
    -- we can check if there are some deals to open
    -- -- very cheap selling deals
    -- -- -- average
    open_deals(l_id_load,'sell');
    
    -- check if there are opening deals which are spoiled to be opened
    for l_rec in (select * from t_risky_deals d where d.state = 'new')
    loop
        select/*+ RESULT_CACHE */ m.fee into l_market_fee from t_market m where m.id = l_rec.id_market;                     
        -- calling web api
        -- testing reason
        if dbms_random.value(1,1000) <= 500 then
           -- if state is ok, we update the deal
            update t_risky_deals d
            set d.state = 'accepted'
            where d.id_deal = l_rec.id_deal;
            --
            if l_rec.deal_type = 'buy' then
              update t_risk_market_balance b
              set b.current_balance = b.current_balance+l_rec.ordered_amount
              where b.id_market = l_rec.id_market
              and   b.cur_code = 'ltc';
            else
              update t_risk_market_balance b
              set b.current_balance = b.current_balance+(1-l_market_fee/100)*l_rec.ordered_amount*l_rec.rate
              where b.id_market = l_rec.id_market
              and   b.cur_code = 'btc';
            end if;              
           -- if it's so now we are opening oposite deal with profit
           open_oposit_deal(l_rec);
        else 
           -- how old this thing?
           -- time required only for technical needs, it should be opened after 1 min maximum
           if SYSDATE-l_rec.deal_dt > 1 / 24 / 60 then 
              -- we have to close this deal
              -- web-api cancel order
              update t_risky_deals d 
              set d.state = 'spoiled'
              where d.id_deal = l_rec.id_deal;
              -- balance updating
              if l_rec.deal_type = 'buy' then
                update t_risk_market_balance b
                set b.current_balance = b.current_balance+(1+l_market_fee/100)*l_rec.ordered_amount*l_rec.rate 
                where b.id_market = l_rec.id_market
                and   b.cur_code = 'btc';
              else
                update t_risk_market_balance b
                set b.current_balance = b.current_balance+l_rec.ordered_amount
                where b.id_market = l_rec.id_market
                and   b.cur_code = 'ltc';
              end if;  
              commit;
           else
              -- we'll wait
              null;
           end if;
        end if;
    end loop;
    
    -- check if there are closing deals which are done
    for l_rec in (select * from t_risky_deals_closed d where d.state = 'new')
    loop
        -- calling web api

        -- testing reason
        select sum(h.amount)
        into l_deal_am
        from t_deals_history h
        where h.id_load = l_id_load
        and   h.id_market = l_rec.id_market
        and   (
        (      l_rec.o_deal_type = 'buy'
        and   h.buy_sell = 'buy'
        and   h.rate >= l_rec.rate)
        OR
        (      l_rec.o_deal_type = 'sell'
        and   h.buy_sell = 'sell'
        and   h.rate <= l_rec.rate)
        )
        ;
        
       if l_deal_am > 0 then
          -- and a balance
          select/*+ RESULT_CACHE */ m.fee into l_market_fee from t_market m where m.id = l_rec.id_market;                     
           if l_deal_am >= l_rec.amount then
               -- if state is ok, we update the closing deal
                update t_risky_deals_closed d
                set d.state = 'done', d.id_load = l_id_load
                where d.id_deal_open = l_rec.id_deal_open;
                -- and opening deal
                update t_risky_deals d
                  set d.state = 'done'
                  where d.id_deal = l_rec.id_deal_open;
                -- updating balances too
                if l_rec.o_deal_type = 'buy' then
                  update t_risk_market_balance b
                   set b.current_balance = b.current_balance+(1-l_market_fee/100)*l_rec.amount*l_rec.rate
                   where b.id_market = l_rec.id_market
                   and   b.cur_code = 'btc';
                else
                  update t_risk_market_balance b
                   set b.current_balance = b.current_balance+l_rec.amount
                   where b.id_market = l_rec.id_market
                   and   b.cur_code = 'ltc';
                end if;
                 --
             else -- testing case
                update t_risky_deals_closed d
                set d.amount = d.amount - l_deal_am
                where d.id_deal_open = l_rec.id_deal_open;
                -- updating balances too
                if l_rec.o_deal_type = 'buy' then
                  update t_risk_market_balance b
                   set b.current_balance = b.current_balance+(1-l_market_fee/100)*l_deal_am*l_rec.rate
                   where b.id_market = l_rec.id_market
                   and   b.cur_code = 'btc';
                else
                   update t_risk_market_balance b
                   set b.current_balance = b.current_balance+l_deal_am
                   where b.id_market = l_rec.id_market
                   and   b.cur_code = 'ltc';
--                   p(l_rec.id_deal_open);
                end if;
                 --
             end if;
             commit;
        else 
           -- how old is this closing deal ?
           -- we can't wait for too long
           if SYSDATE-l_rec.dt > 1  then 
              -- we have to worry some how
              -- logging something
              null;
           else
              -- we'll wait
              null;
           end if;
        end if;
    end loop;
    
    -- check accepted opening deals, who are very old
    -- -- testing thing
    select min(dt) into l_load_dt from t_deals_history h where h.id_load = l_id_load;
    for l_rec in ( select *
                   from t_risky_deals d 
                   where d.state = 'accepted' and 
                   d.deal_dt < l_load_dt - 3* (select nvl(cd.rollback_atempts,0)+1 
                                               from t_risky_deals_closed cd 
                                               where cd.id_deal_open = d.id_deal)
                 )
    loop
      -- we have to rollback last closing deal
      -- web api
      -- and start next one with the same rate as openning deal and amount from closing (it could be partialy executed)
      -- web api
      if l_rec.deal_type = 'buy' then
        update t_risky_deals_closed cd 
        set cd.rate = (1-NVL(cd.rollback_atempts,0)*0.1)*l_rec.rate, cd.rollback_atempts=NVL(cd.rollback_atempts,0)+1
        where cd.id_deal_open = l_rec.id_deal;
      else
        select/*+ RESULT_CACHE */ m.fee into l_market_fee from t_market m where m.id = l_rec.id_market;                             
        --
        update t_risky_deals_closed cd 
        set cd.rate = (1+NVL(cd.rollback_atempts,0)*0.1)*l_rec.rate, 
            cd.rollback_atempts=NVL(cd.rollback_atempts,0)+1,
            cd.amount = cd.amount * cd.rate / ((1+NVL(cd.rollback_atempts,0)*0.1)*l_rec.rate) * (1-l_market_fee/100)
        where cd.id_deal_open = l_rec.id_deal;

      end if;
      commit;
    end loop;
    
  end;
end pk_risk_arbitrage;
/

prompt
prompt Creating package body PK_TOOL
prompt =============================
prompt
create or replace package body freedom.pk_tool is
 g_timing    boolean := TRUE;
 
 type t_hash_number is table of number index by binary_integer;

/******************************/
/** private functions section */
/******************************/
  function get_market_name(a_id number) return varchar2
  is 
     l_name varchar2(20);
  begin
     select m.name
     into l_name
     from t_market m
     where m.id = a_id;
     return l_name;
  exception
    when no_data_found then
      raise_application_error(-20002, 'There is no such market as '||a_id||', sorry dude!');
  end;
  
  function put_conn(a_market_deal number, a_deal number) return number
  is 
      pragma autonomous_transaction;
  begin
      insert into t_job_communication
      values (seq_job_comm_id.nextval, a_market_deal,a_deal, 'new', null,seq_manager_id.currval);
      commit;
      return seq_job_comm_id.currval;
  end;
  
  function get_free_procceder return varchar2
  is
     l_job_name varchar2(32);
  begin
      -- let's find free job
      select j.job_name
      into l_job_name
      from all_scheduler_jobs j
      where j.job_name like 'PROCCES_THE_DEAL_%'
      and not exists( select 'x'
                    from MY_RUNNING_JOBS rj
                    where rj.job_name = j.job_name)
      and rownum = 1;
      insert into MY_RUNNING_JOBS values(l_job_name);
      return l_job_name;
  exception
    when no_data_found then
      -- there is no free job, we have to create a new one
      l_job_name := 'PROCCES_THE_DEAL_'||jobs_proccess_the_deal_id.nextval;
      dbms_scheduler.create_job(l_job_name, program_name=>'procces_the_deal');
      insert into MY_RUNNING_JOBS values(l_job_name);
      return l_job_name;
  end;
/***************************************************************/
/*********** Public section ************************************/
/***************************************************************/ 
  procedure log(a_msg varchar2)
  is
      pragma autonomous_transaction;
  begin
    insert into t_log(msg) values(substr(a_msg,1,200));
    commit;
  end;

  /** deciding if the pair is profitable                                                               */
  /* returns K - relation of income to expenseaces in all amount of the market account                 */
  function deal_K(buy_deal_rate number, 
                 sell_deal_rate number, 
                 buy_market_fee number, 
                 sell_market_fee number, 
                 buy_market_comm_cur number, 
                 sell_market_comm_cur number, 
                 buy_market_comm_pct number, 
                 sell_market_comm_pct number, 
                 buying_cur_initial_amount number, 
                 selling_cur_initial_amount number
                 
  ) return number
  is
       l_mda       number := Least(buying_cur_initial_amount/sell_deal_rate,selling_cur_initial_amount); -- maximum deal amount
  begin
       return ((buy_deal_rate-sell_deal_rate) * l_mda) /
              ( l_mda * ((sell_market_fee+sell_market_comm_pct)*sell_deal_rate+(buy_deal_rate+buy_market_comm_pct)*buy_market_fee)/100+
              buy_market_comm_cur*sell_deal_rate+sell_market_comm_cur );
  end; 

  /** deciding if the pair is balancig               */
  /* return profit in %                              */
  function balanced_deal_profit(buy_deal_rate number, sell_deal_rate number, buy_market_fee number, sell_market_fee number) return number
  is
  begin
     RETURN ( (buy_deal_rate-sell_deal_rate) - (buy_deal_rate*buy_market_fee/100 + sell_deal_rate*sell_market_fee/100) ) / sell_deal_rate;
  end; 

  procedure get_deals_history(a_market_id number DEFAULT NULL)
  is
    l_load_id  number;
  begin
    if a_market_id is null then
      l_load_id  := seq_load_id.nextval;
      for l_rec in (select m.id from t_market m where m.enabled = 'Y')
      loop
        get_deals_history(l_rec.id);
      end loop;
    else 
       l_load_id := seq_load_id.currval;
      -- selecting all currencies pairs
      for l_pair in (select p.cur_from, p.cur_to from t_pairs p)
      loop
        execute immediate
          'insert into t_deals_history(id_load, id_market, buy_sell, cur_from, rate, cur_to, amount)
          select :1, :2, t.buysell, :3, t.rate, :4, NVL(t.amount,0)
          from table(pk_'||get_market_name(a_market_id)||'.book('''||l_pair.cur_from||''','''||l_pair.cur_to||''')) t'
        USING l_load_id, a_market_id, l_pair.cur_from, l_pair.cur_to;
      end loop;
    end if;
  end;
  
  procedure get_deals_history_v2
  is
    l_load_id  number := seq_load_id.nextval;
    l_max_work_time number := 1/24/60/60*2;
    l_start_time date := SYSDATE;
    --
    l_job_name varchar2(30) ;
    l_jobs_cnt number:=0;
  begin
    update t_system_params p
    set p.param_value = l_load_id
    where p.param_code = 'current_load_id';
    commit;
    
    for l_rec in (select m.id from t_market m where m.enabled = 'Y' order by (select c.call_limit from t_market_connection c where c.id_market = m.id))
     loop
       -- selecting all currencies pairs
       for l_pair in (select p.cur_from, p.cur_to from t_pairs p)
       loop
         -- specifing a job name
         l_job_name := 'deals_his_'||get_market_name(l_rec.id)||'_'||l_pair.cur_from||'_'||l_pair.cur_to;
         -- if there is already done job
         declare 
            l_cnt number;
         begin
            select count(*) into l_cnt from user_scheduler_jobs j where j.job_name = UPPER(l_job_name);
            if l_cnt = 0 then
              dbms_scheduler.create_job(job_name => l_job_name,
                                        job_type => 'PLSQL_BLOCK',
                                        job_action => 'BEGIN
                                                           insert into t_deals_history(id_load, id_market, buy_sell, cur_from, rate, cur_to, amount)
                                                           select (select p.param_value from t_system_params p where p.param_code = ''current_load_id''), '||l_rec.id||', t.buysell, '''||l_pair.cur_from||''', t.rate, '''||l_pair.cur_to||''', NVL(t.amount,0)
                                                           from table(pk_'||get_market_name(l_rec.id)||'.book('''||l_pair.cur_from||''','''||l_pair.cur_to||''')) t;
                                                       END;',
                                        repeat_interval => null,
                                        auto_drop => FALSE);
            end if;
         end;
         -- execute a job
         dbms_scheduler.run_job(job_name => l_job_name,use_current_session => FALSE);
         l_jobs_cnt := l_jobs_cnt +1;
       end loop;
     end loop;
     -- now we are waiting while all the jobs end or the time runs out
     declare 
        l_cnt number;
     begin
       while sysdate-l_start_time < l_max_work_time loop
           select count(*) into l_cnt
           from (
                      select distinct h.id_market,h.cur_from, h.cur_to from  t_deals_history h where h.id_load = l_load_id
                 );
--          select count(*) into l_cnt from user_scheduler_running_jobs j where j.job_name = UPPER('deals_his_%');
          exit when l_cnt = l_jobs_cnt ;
       end loop;
     end;
     return;
  end;
  
  -- searching profitable deals and putting them to the separete table
  procedure load_new_profit(a_id_load number default null)
  is
     l_load_id      number := a_id_load;
     l_load_time    date;
  begin
    -- clean the table 
    insert into t_deals_end_state
    select p.*,'spoiled',null,null,null  from t_deals_to_process p;
    --
    delete from t_deals_to_process;

    if a_id_load is null then
        select max(h.id_load)
        into l_load_id
        from t_deals_history h;
    end if;
    -- check the time of last load
    select min(dt) into l_load_time  from t_deals_history h where h.id_load = l_load_id;
    if sysdate-l_load_time > 1/24/60/60*5 /*5 sec*/ then 
      log('load timed out! load_id = '||l_load_id||' and load_time = '|| l_load_time);
      return; 
    end if;
    -- 
   insert into t_deals_to_process
   with v_load as
    (select * from v_deals_to_process where ID_LOAD = l_load_id)
     select seq_deals_to_process.nextval, v.*
           from v_load v
           where   (select count(*) from v_load t1 where (t1.buy_market = v.buy_market or t1.sell_market = v.buy_market) and t1.dealk > v.dealk) = 0 
             and   (select count(*) from v_load t1 where (t1.buy_market = v.sell_market or t1.sell_market = v.sell_market) and t1.dealk > v.dealk) = 0 ;
/*     select seq_deals_to_process.nextval, v.*
       from v_deals_to_process v
      where v.ID_LOAD = l_load_id
        and 
            (v.buy_id, v.SELL_ID) IN
            (select min(t_all.buy_id), min(t_all.SELL_ID)
                from (select v_in.BUY_ID,
                             v_in.SELL_ID,
                             v_in.dealk,
                             v_in.buy_market,
                             v_in.SELL_market,
                             rank() over(partition by v_in.buy_market, v_in.SELL_market Order by v_in.DEALK desc) val_rank
                        from v_deals_to_process v_in
                       where v_in.ID_LOAD = l_load_id) t_all
               where t_all.val_rank = 1
               group by t_all.buy_market, t_all.SELL_market);
               */
  end;
  
  procedure procces_the_deal(a_mn varchar2,
                             a_mid number, 
                             a_buysell varchar2, 
                             a_rate    number,
                             a_cur_from varchar2, 
                             a_cur_to varchar2, 
                             a_am number, 
                             a_com_id number)
  is
       l_cmd         varchar2(1000);
       l_id_order    varchar2(100);
  begin
       l_cmd := 
       ' begin
           :ord_id :=
           pk_'||a_mn||'.make_order(a_buysell => '''||a_buysell||''',a_cur_from => :cur_from, a_rate => :rate, a_cur_to => :cur_to ,a_amount => :am);
         end;';
       execute immediate l_cmd using OUT l_id_order, a_cur_from, a_rate, a_cur_to, a_am;

--         if l_id_order is not null then
            update t_job_communication c
            set c.status = 'ok', c.msg = l_id_order
            where c.id = a_com_id;
/*         else
            raise_application_error(-20001, 'Didn''t get an order id');
         end if;
*/         
       exception
          when others then
            
            declare 
               l_err_msg varchar2(1000) := dbms_utility.format_error_stack;
            begin
               log(a_mn||':'||l_err_msg);
               update t_job_communication c
               set c.status = 'fail', c.msg = substr(l_err_msg,1,200)
               where c.id = a_com_id;
            end;
    end;
  
  -- proccessing profitable deals parallel version
  procedure process_new_profit_v2
  is
     la_deal   t_deals_to_process%rowtype;
     
     cursor c_am(a_id_market number, a_cur varchar2) is
     select  b.current_balance, b.init_balance
      from t_market_balance b
      where b.id_market = a_id_market
      and   b.cur_code = a_cur;
     
     la_buy_amounts       c_am%rowtype;
     la_sell_amounts      c_am%rowtype;
     
     l_deal_amount        number;
     l_state              varchar2(20);
     
     l_sell_market_res    varchar2(5);
     l_buy_market_res     varchar2(5);
     
     l_sell_market_fee    number;
     l_buy_market_fee     number;
     
     --
     l_sell_id_order varchar2(200);
     l_buy_id_order varchar2(200);
     --
     l_sell_min     number;
     l_buy_min      number;
     --
     l_manager_id   number := seq_manager_id.nextval;
     l_job_com_cnt  number ;
     --
     l_job_name     varchar2(32);
     --
     l_start_tm     date:=sysdate;
     --
     l_some_job_done boolean := false;
     --
     l_balancing     boolean := false;
     -- amount of deals counter
     l_deals_counter int := 0;
     -- we have to count amount of deals beeing executed, to eliminate doubles
     la_deals_amount_left t_hash_number;
     -- serving procedure
     procedure update_deals_amounts_left(a_deal1 number, a_deal2 number, a_amount number)
     is
     begin
         -- 
           la_deals_amount_left(a_deal1) := la_deals_amount_left(a_deal1) - a_amount;
           la_deals_amount_left(a_deal2) := la_deals_amount_left(a_deal2) - a_amount;
       end;
       
     procedure check_deal_left(a_deal number, a_cur_amount IN OUT number)
     is
     begin
         -- first we have to check if these deals have been already executed
        if la_deals_amount_left.exists(a_deal) then
          -- if yes we have to update amount left
          a_cur_amount := la_deals_amount_left(a_deal);
        else
          -- in this case we have to write down current amount
          la_deals_amount_left(a_deal) := a_cur_amount;
        end if;
     end;
     
     
     procedure clean_stuff(a_pair_deal number, a_state varchar2)
     is
     begin
         update t_deals_end_state s
          set s.state = a_state
          where s.id = a_pair_deal;
          --
          delete from t_job_communication c
          where c.id_pair_deal = a_pair_deal;
       end;
     -- update the balance  
     procedure update_balance(a_pair_deal number)
     is
        la_deal_pair   t_deals_end_state%rowtype;
     begin
       select * into la_deal_pair from t_deals_end_state s where s.id = a_pair_deal;
       update t_market_balance mb
       set mb.current_balance = nvl((select b.amount 
                                from v_real_balances b 
                                where b.market_name = get_market_name(mb.id_market) 
                                and b.cur = mb.cur_code),0)
       where mb.id_market IN (la_deal_pair.buy_market,la_deal_pair.sell_market) ;
     exception
       when others then null;
     end;
          
  begin
    begin
      select nvl(p.param_value,0) into l_deals_counter from t_system_params p where p.param_code = 'deals_per_action';
      for i in 1..l_deals_counter loop
      l_state :='not procedeed';
      -- gettng first deal from the list
      select * into la_deal from t_deals_to_process p where rownum = 1 and sysdate-l_start_tm < 1/24/60/60*2 order by p.deal_type, p.dealk desc;
      delete from t_deals_to_process p where p.id = la_deal.id;
      if g_timing then log('starting process procedure, deal = '||la_deal.id); end if;
      l_some_job_done := true;
      
      -- getting fees
      select/*+ RESULT_CACHE */ m.fee into l_buy_market_fee from t_market m where m.id = la_deal.buy_market;
      select/*+ RESULT_CACHE */ m.fee into l_sell_market_fee from t_market m where m.id = la_deal.sell_market;
      
      -- estimate deal amount
      open c_am(la_deal.buy_market,la_deal.cur_to);
      fetch c_am into la_buy_amounts;
      close c_am;                      
      
      open c_am(la_deal.sell_market,la_deal.cur_from);
      fetch c_am into la_sell_amounts;
      close c_am;    
      

      -- first we have to check if these deals have been already executed
      check_deal_left(la_deal.buy_id,la_deal.buy_amount);
      check_deal_left(la_deal.sell_id,la_deal.sell_amount);      
      
      -- if this is balancing deal, then less proficit is or amount      
      if la_deal.deal_type = 1 then
          l_deal_amount := 0.99 * least(la_deal.buy_amount,la_buy_amounts.current_balance-la_buy_amounts.init_balance,
                                 la_deal.sell_amount,(la_sell_amounts.current_balance-la_sell_amounts.init_balance)/la_deal.sell_rate);
      else 
         
              l_deal_amount := 0.99 * least(la_deal.buy_amount,la_buy_amounts.current_balance,
                                 la_deal.sell_amount,(la_sell_amounts.current_balance)/la_deal.sell_rate);
                                 
       
      end if;    
      
      -- process deal
      select NVL(min_val,0) into l_sell_min from t_market_commision c where c.id_market = la_deal.sell_market and c.cur_code = la_deal.cur_to;
      select NVL(min_val,0) into l_buy_min from t_market_commision c where c.id_market = la_deal.buy_market and c.cur_code = la_deal.cur_to;
      -- --    
      if l_deal_amount > greatest(l_sell_min,l_buy_min) then
              -- updating both deals
              update_deals_amounts_left(la_deal.sell_id,la_deal.buy_id,l_deal_amount);
              
              l_job_name := get_free_procceder;
              if g_timing then log('creating buy deal ('||round(l_deal_amount,6)||') '||la_deal.sell_id|| ' job : '||l_job_name); end if;
              dbms_scheduler.set_job_argument_value(job_name => l_job_name,
                                                    argument_name => 'A_MN',
                                                    argument_value => get_market_name(la_deal.sell_market));
              dbms_scheduler.set_job_argument_value(job_name => l_job_name,
                                                    argument_name => 'A_MID',
                                                    argument_value => la_deal.sell_market);
              dbms_scheduler.set_job_argument_value(job_name => l_job_name,
                                                    argument_name => 'A_BUYSELL',
                                                    argument_value => 'buy');                                                    
              dbms_scheduler.set_job_argument_value(job_name => l_job_name,
                                                    argument_name => 'A_RATE',
                                                    argument_value => case when la_deal.sell_market = 1 then la_deal.buy_rate*(1-l_sell_market_fee/100) else la_deal.sell_rate end);                                                    
              dbms_scheduler.set_job_argument_value(job_name => l_job_name,
                                                    argument_name => 'A_CUR_FROM',
                                                    argument_value => la_deal.cur_from);                                                    
              dbms_scheduler.set_job_argument_value(job_name => l_job_name,
                                                    argument_name => 'A_CUR_TO',
                                                    argument_value => la_deal.cur_to);                                                                                                        
              dbms_scheduler.set_job_argument_value(job_name => l_job_name,
                                                    argument_name => 'A_AM',
                                                    argument_value => l_deal_amount);
              dbms_scheduler.set_job_argument_value(job_name => l_job_name,
                                                    argument_name => 'A_COM_ID',
                                                    argument_value => put_conn(la_deal.sell_id,la_deal.id));
              dbms_scheduler.run_job(job_name => l_job_name,use_current_session => FALSE);
              /*
              pk_tool.procces_the_deal(get_market_name(la_deal.sell_market),
                                       la_deal.sell_market, 
                                       'buy', 
                                       la_deal.sell_rate, 
                                       la_deal.cur_from, 
                                       la_deal.cur_to, 
                                       l_deal_amount, 
                                       put_conn(la_deal.sell_id,la_deal.id));
               */                                       
              
                l_job_name := get_free_procceder;
                if g_timing then log('creating sell deal ('||round(l_deal_amount,6)||') '||la_deal.buy_id|| ' job : '||l_job_name); end if;
                dbms_scheduler.set_job_argument_value(job_name => l_job_name,
                                                      argument_name => 'A_MN',
                                                      argument_value => get_market_name(la_deal.buy_market));
                dbms_scheduler.set_job_argument_value(job_name => l_job_name,
                                                      argument_name => 'A_MID',
                                                      argument_value => la_deal.buy_market);
                dbms_scheduler.set_job_argument_value(job_name => l_job_name,
                                                      argument_name => 'A_BUYSELL',
                                                      argument_value => 'sell');                                                    
                dbms_scheduler.set_job_argument_value(job_name => l_job_name,
                                                      argument_name => 'A_RATE',
                                                      argument_value => case when la_deal.buy_market = 1 then la_deal.sell_rate*(1+l_buy_market_fee/100) else la_deal.buy_rate end);                                                    
                dbms_scheduler.set_job_argument_value(job_name => l_job_name,
                                                      argument_name => 'A_CUR_FROM',
                                                      argument_value => la_deal.cur_from);                                                    
                dbms_scheduler.set_job_argument_value(job_name => l_job_name,
                                                      argument_name => 'A_CUR_TO',
                                                      argument_value => la_deal.cur_to);                                                                                                        
                dbms_scheduler.set_job_argument_value(job_name => l_job_name,
                                                      argument_name => 'A_AM',
                                                      argument_value => l_deal_amount);
                dbms_scheduler.set_job_argument_value(job_name => l_job_name,
                                                      argument_name => 'A_COM_ID',
                                                      argument_value => put_conn(la_deal.buy_id,la_deal.id));
                dbms_scheduler.run_job(job_name => l_job_name,use_current_session => FALSE);
                /*
                pk_tool.procces_the_deal(get_market_name(la_deal.buy_market),
                                       la_deal.buy_market, 
                                       'sell', 
                                       la_deal.buy_rate, 
                                       la_deal.cur_from, 
                                       la_deal.cur_to, 
                                       l_deal_amount, 
                                       put_conn(la_deal.buy_id,la_deal.id));
                */                       
                l_state := 'pending';
                
                -- update estimated balance
                 update t_market_balance b
                 set b.current_balance = b.current_balance-(1+l_sell_market_fee/100)*l_deal_amount*la_deal.sell_rate 
                 where b.id_market = la_deal.sell_market
                 and   b.cur_code = la_deal.cur_from;
                 --
                 update t_market_balance b
                 set b.current_balance = b.current_balance+l_deal_amount
                 where b.id_market = la_deal.sell_market
                 and   b.cur_code = la_deal.cur_to;

                 update t_market_balance b
                 set b.current_balance = b.current_balance+(1-l_buy_market_fee/100)*l_deal_amount*la_deal.buy_rate
                 where b.id_market = la_deal.buy_market
                 and   b.cur_code = la_deal.cur_from;
                 --
                 update t_market_balance b
                 set b.current_balance = b.current_balance-l_deal_amount
                 where b.id_market = la_deal.buy_market
                 and   b.cur_code = la_deal.cur_to;

      else
          l_state:='not balanced';  
          l_balancing := true;
          log('not balanced!');
      end if;
      
      insert into t_deals_end_state s
       values (la_deal.id,la_deal.id_load,la_deal.buy_id,la_deal.sell_id, la_deal.dealk, la_deal.deal_type,
               la_deal.buy_rate,la_deal.sell_rate,la_deal.buy_market,la_deal.sell_market,la_deal.cur_from,la_deal.cur_to,
               la_deal.buy_amount,la_deal.sell_amount, l_state, sysdate, l_deal_amount, l_deal_amount*(la_deal.buy_rate-la_deal.sell_rate));
               
      
       
      commit;
      
      end loop;
    exception
      when no_data_found then
        --  seems there is no profit or balancing operations this time, well, bad lack.
        null;
    end;
    
    delete from MY_RUNNING_JOBS;
    
    -- result manager section
    select count(*) into l_job_com_cnt from t_job_communication c where c.manager_id = l_manager_id;
    while l_job_com_cnt > 0 loop
      
      -- check if there some deal with status not new
      for la_com in (select c1.id_market_deal as id_market_deal_1,c1.status as status_1,c1.msg as msg_1,
                            c2.id_market_deal as id_market_deal_2,c2.status as status_2,c2.msg as msg_2,
                            c1.id_pair_deal 
                     from t_job_communication c1,
                          t_job_communication c2
                     where c1.id_pair_deal = c2.id_pair_deal
                     and c1.manager_id = l_manager_id 
                     and c2.manager_id = l_manager_id
                     and c1.id_market_deal <> c2.id_market_deal
                     and c1.id_market_deal > c2.id_market_deal
                     and c1.status <> 'new'
                     and c2.status <> 'new') 
      loop
          -- if there are both failed
          if la_com.status_1 = 'fail' and la_com.status_2 = 'fail' then
             -- firstable we should logg the error
             log('deal pair '||la_com.id_pair_deal||' failed with errors: '||la_com.msg_1|| ' and '|| la_com.msg_2);
             -- update the balance
             update_balance(la_com.id_pair_deal);
             /*
             declare
                la_deal_pair   t_deals_end_state%rowtype;
             begin
               select * into la_deal_pair from t_deals_end_state s where s.id = la_com.id_pair_deal;
               update t_market_balance mb
               set mb.current_balance = nvl((select b.amount 
                                        from v_real_balances b 
                                        where b.market_name = get_market_name(mb.id_market) 
                                        and b.cur = mb.cur_code),0)
               where mb.id_market IN (la_deal_pair.buy_market,la_deal_pair.sell_market) ;
             exception
               when others then null;
             end;
             */
             -- clean the stuff
             clean_stuff(la_com.id_pair_deal, 'failed');
          elsif la_com.status_1 = 'ok' and la_com.status_2 = 'ok' then
             -- firstable we should logg the error
             log('deal pair '||la_com.id_pair_deal||' compleated successfuly');
             -- update the balance
             update_balance(la_com.id_pair_deal);
             /*
             declare
                la_deal_pair   t_deals_end_state%rowtype;
             begin
               select * into la_deal_pair from t_deals_end_state s where s.id = la_com.id_pair_deal;
               update t_market_balance mb
               set mb.current_balance = nvl((select b.amount 
                                        from v_real_balances b 
                                        where b.market_name = get_market_name(mb.id_market) 
                                        and b.cur = mb.cur_code),0)
               where mb.id_market IN (la_deal_pair.buy_market,la_deal_pair.sell_market) ;
             exception
               when others then null;
             end;
             */
             -- clean the stuff
             clean_stuff(la_com.id_pair_deal, 'done');
          else --some deal failed and the other not             
             --
             declare
                l_fail_deal      number := case when la_com.status_1 = 'fail' then la_com.id_market_deal_1 else la_com.id_market_deal_2 end;
                l_fail_msg       varchar2(3000) := case when la_com.status_1 = 'fail' then la_com.msg_1 else la_com.msg_2 end;
                l_ok_deal        number := case when la_com.status_1 = 'ok' then la_com.id_market_deal_1 else la_com.id_market_deal_2 end;
                l_ok_msg         varchar2(3000) := case when la_com.status_1 = 'ok' then la_com.msg_1 else la_com.msg_2 end;
                --
                l_res   varchar2(2);
                l_cmd   varchar2(1000);
                la_ok_deal t_deals_history%rowtype;
              begin
                  -- try to cancel
                 select * into la_ok_deal from t_deals_history h where h.id = l_ok_deal;
                 --
                 if get_market_name(la_ok_deal.id_market) = 'coins_e' then
                   l_cmd := 'begin
                               :res:=
                               pk_'||get_market_name(la_ok_deal.id_market)||'.cancel_order(:l_id, :cur_from, :cur_to);
                             end;';
                    execute immediate l_cmd USING OUT l_res, l_ok_msg,la_ok_deal.cur_from,la_ok_deal.cur_to;                                     
                 else
                    l_cmd := 'begin
                               :res:=
                               pk_'||get_market_name(la_ok_deal.id_market)||'.cancel_order(:l_id);
                             end;';
                    execute immediate l_cmd USING OUT l_res, l_ok_msg;
                 end if;
                 log('deals:'||la_com.id_pair_deal||', rolling back order ('||l_ok_msg||') '||get_market_name(la_ok_deal.id_market)||' res: '||l_res);
                 -- if cancelation is success then clean all the stuff and relax
                 -- clean the stuff
                 clean_stuff(la_com.id_pair_deal, 'canceled');
             exception
                when others then
                  log('deals:'||la_com.id_pair_deal||', exception rolling back order ('||l_ok_msg||') '||get_market_name(la_ok_deal.id_market)||' res: '||dbms_utility.format_error_stack);
                  -- fuck operation is procceded already we have to turn off this market and ask user to fix it manualy (for now at least)
                   update t_market m
                   set m.enabled = 'N'
                   where m.id = la_ok_deal.id_market;       
                   -- updating balance
                   update_balance(la_com.id_pair_deal);
                   /*
                   begin
                     update t_market_balance mb
                     set mb.current_balance = nvl((select b.amount 
                                              from v_real_balances b 
                                              where b.market_name = get_market_name(mb.id_market) 
                                              and b.cur = mb.cur_code),0)
                     where mb.id_market = la_ok_deal.id_market;
                   exception
                        when others then null;
                   end;
                   */
                   -- 
                   -- clean the stuff
                   clean_stuff(la_com.id_pair_deal, 'stuck');                                
              end;
          end if;
          commit;
      end loop;
      -- next check
      select count(*) into l_job_com_cnt from t_job_communication c where c.manager_id = l_manager_id;
    end loop;
    -- if there was some not balanced deals, check the real balances
    if l_balancing then 
      begin
            make_equal; 
      exception
            when others then null;
      end;
    end if;
    commit;
    -- if there was some not balanced deals, check the real balances
    if l_balancing then make_equal; end if;
    if l_some_job_done and g_timing then log('ending process procedure'); end if;
  end;
  
  -- proccessing profitable deals
  procedure process_new_profit
  is
     la_deal   t_deals_to_process%rowtype;
     
     cursor c_am(a_id_market number, a_cur varchar2) is
     select  b.current_balance, b.init_balance
      from t_market_balance b
      where b.id_market = a_id_market
      and   b.cur_code = a_cur;
     
     la_buy_amounts       c_am%rowtype;
     la_sell_amounts      c_am%rowtype;
     
     l_deal_amount        number;
     l_state              varchar2(20);
     
     l_sell_market_res    varchar2(5);
     l_buy_market_res     varchar2(5);
     
     l_sell_market_fee    number;
     l_buy_market_fee     number;
     
     --
     l_sell_id_order varchar2(200);
     l_buy_id_order varchar2(200);
     --
     l_sell_min     number;
     l_buy_min      number;
          
  begin
    
    loop
    l_state :='not procedeed';
    -- gettng first deal from the list
    select * into la_deal from t_deals_to_process p where rownum = 1 order by p.deal_type, p.dealk desc;
    delete from t_deals_to_process p where p.id = la_deal.id;
    if g_timing then log('starting process procedure, deal = '||la_deal.id); end if;
    
    -- getting fees
    select/*+ RESULT_CACHE */ m.fee into l_buy_market_fee from t_market m where m.id = la_deal.buy_market;
    select/*+ RESULT_CACHE */ m.fee into l_sell_market_fee from t_market m where m.id = la_deal.sell_market;
    
    -- estimate deal amount
    open c_am(la_deal.buy_market,la_deal.cur_to);
    fetch c_am into la_buy_amounts;
    close c_am;                      
    
    open c_am(la_deal.sell_market,la_deal.cur_from);
    fetch c_am into la_sell_amounts;
    close c_am;    
    
    -- if this is balancing deal, then less proficit is or amount
    if la_deal.deal_type = 1 then
        l_deal_amount := least(la_deal.buy_amount,la_buy_amounts.current_balance-la_buy_amounts.init_balance,
                               la_deal.sell_amount,(la_sell_amounts.current_balance-la_sell_amounts.init_balance)/la_deal.sell_rate);
    else 
        -- check if the amount to small in comparing with balance
        if la_buy_amounts.current_balance/la_buy_amounts.init_balance < 0.01 or la_sell_amounts.current_balance/la_sell_amounts.init_balance < 0.01 then
          -- balancing required
          l_deal_amount := 0; 
        else 
            l_deal_amount := least(la_deal.buy_amount,la_buy_amounts.current_balance,
                               la_deal.sell_amount,(la_sell_amounts.current_balance)/la_deal.sell_rate);
                               
        end if;            
     
    end if;    
    
    -- process deal
    select NVL(min_val,0) into l_sell_min from t_market_commision c where c.id_market = la_deal.sell_market and c.cur_code = la_deal.cur_to;
    select NVL(min_val,0) into l_buy_min from t_market_commision c where c.id_market = la_deal.buy_market and c.cur_code = la_deal.cur_to;
    -- --    
    if l_deal_amount > greatest(l_sell_min,l_buy_min) then
         -- 1. -- creating a buy deal
            if g_timing then log('creating buy deal '||la_deal.sell_id); end if;
            l_sell_market_res := 'no';
            declare
               l_cmd         varchar2(1000);
            begin
               l_cmd := 
               ' begin
                   :ord_id :=
                   pk_'||get_market_name(la_deal.sell_market)||'.make_order(a_buysell => ''buy'',a_cur_from => :cur_from, a_rate => :rate, a_cur_to => :cur_to ,a_amount => :am);
                 end;';
               execute immediate l_cmd using OUT l_sell_id_order, la_deal.cur_from, la_deal.sell_rate, la_deal.cur_to, l_deal_amount;

               if l_sell_id_order is not null then
                  l_sell_market_res:='ok';
               end if;
             exception
                when others then
                   log(get_market_name(la_deal.sell_market)||':'||sqlerrm);
                   l_sell_market_res:='fail';
             end;
         -- 2. -- creating sell deal
         
         l_buy_market_res := 'no';
         if l_sell_market_res ='ok' then
              if g_timing then log('creating sell deal '||la_deal.buy_id); end if;
              declare
                 l_cmd         varchar2(1000);
              begin
                 l_cmd := 
                 ' begin
                     :ord_id :=
                     pk_'||get_market_name(la_deal.buy_market)||'.make_order(a_buysell => ''sell'',a_cur_from => :cur_from, a_rate => :rate, a_cur_to => :cur_to ,a_amount => :am);
                   end;';
                 execute immediate l_cmd using OUT l_buy_id_order, la_deal.cur_from, la_deal.buy_rate, la_deal.cur_to, l_deal_amount;

                 if l_buy_id_order is not null then
                    l_buy_market_res:='ok';
                 end if;
               exception
                  when others then
                     log(get_market_name(la_deal.buy_market)||':'||sqlerrm);
                     l_buy_market_res:='fail';
                     -- let's try to rollback sell market
                     declare
                         l_res varchar2(2);
                         l_cmd varchar2(1000);
                     begin
                         if get_market_name(la_deal.sell_market) = 'coins_e' then
                           l_cmd := 'begin
                                       :res:=
                                       pk_'||get_market_name(la_deal.sell_market)||'.cancel_order(:l_id, :cur_from, :cur_to);
                                     end;';
                            execute immediate l_cmd USING OUT l_res, l_sell_id_order,la_deal.cur_from,la_deal.cur_to;                                     
                         else
                            l_cmd := 'begin
                                       :res:=
                                       pk_'||get_market_name(la_deal.sell_market)||'.cancel_order(:l_id);
                                     end;';
                            execute immediate l_cmd USING OUT l_res, l_sell_id_order;
                         end if;
                         log('rolling back '||get_market_name(la_deal.sell_market)||' res: '||l_res);
                         l_sell_market_res:='no';
                            
                     exception
                        when others then
                          log('rolling back '||get_market_name(la_deal.sell_market)||' res: '||sqlerrm);
                          l_sell_market_res:='ok';
                     end;
               end;
         end if;
         -- 3. -- updatin balances

            if l_sell_market_res = 'ok' then
               if g_timing then log('updating sell balances'); end if;
               insert into t_market_bal_history 
               values(seq_market_bal_history.nextval,la_deal.id_load, la_deal.sell_market,
                     la_deal.cur_from, -(1+l_sell_market_fee/100)*l_deal_amount*la_deal.sell_rate, la_deal.cur_to, l_deal_amount,la_deal.sell_id);
               --      
               update t_market_balance b
               set b.current_balance = b.current_balance-(1+l_sell_market_fee/100)*l_deal_amount*la_deal.sell_rate 
               where b.id_market = la_deal.sell_market
               and   b.cur_code = la_deal.cur_from;
               --
               update t_market_balance b
               set b.current_balance = b.current_balance+l_deal_amount
               where b.id_market = la_deal.sell_market
               and   b.cur_code = la_deal.cur_to;
             end if;
             if l_buy_market_res = 'ok' then
               ---
               if g_timing then log('updating buy balances'); end if;
               insert into t_market_bal_history 
               values(seq_market_bal_history.nextval,la_deal.id_load, la_deal.buy_market,
                     la_deal.cur_from, (1-l_buy_market_fee/100)*l_deal_amount*la_deal.buy_rate, la_deal.cur_to, -l_deal_amount,la_deal.buy_id);
               ---
               
               --
               update t_market_balance b
               set b.current_balance = b.current_balance+(1-l_buy_market_fee/100)*l_deal_amount*la_deal.buy_rate
               where b.id_market = la_deal.buy_market
               and   b.cur_code = la_deal.cur_from;
               --
               update t_market_balance b
               set b.current_balance = b.current_balance-l_deal_amount
               where b.id_market = la_deal.buy_market
               and   b.cur_code = la_deal.cur_to;
            end if;
               ---
            if l_sell_market_res = 'ok' and l_buy_market_res = 'ok' then
               l_state:='done';
            else
               -- we have to stop all profit generation somehow
               -- I think, desabling market is the better choice
               if l_sell_market_res = 'ok' and l_buy_market_res = 'fail' then
                   update t_market m
                   set m.enabled = 'N'
                   where m.id = la_deal.sell_market;               

                   update t_market m
                   set m.enabled = 'N'
                   where m.id = la_deal.buy_market;               
               end if;               
            end if;
            
    else
        l_state:='not balanced';  
--        log('balancing required');        
    end if;
    
    insert into t_deals_end_state s
     values (la_deal.id,la_deal.id_load,la_deal.buy_id,la_deal.sell_id, la_deal.dealk, la_deal.deal_type,
             la_deal.buy_rate,la_deal.sell_rate,la_deal.buy_market,la_deal.sell_market,la_deal.cur_from,la_deal.cur_to,
             la_deal.buy_amount,la_deal.sell_amount, l_state,null,null,null);
    commit;
    
    end loop;
    
    if g_timing then log('ending process procedure'); end if;

  exception
    when no_data_found then
      --  seems there is no profit or balancing operations this time, well, bad lack.
      null;
  end;
  
  procedure make_equal
  is
  begin
     update t_market_balance b
            set b.current_balance = NVL((select v.amount
                      from v_real_balances v
                      where v.cur = b.cur_code
                      and v.market_name = get_market_name(b.id_market)),0);
  end;
  
  function number_to_char(a_num number) return varchar2
  is 
  begin
      return rtrim(to_char(a_num, 'fm99999990d9999999'), substr(to_char(0,'fm0D'),-1));
  end;
  
  procedure check_freq(a_mn varchar2) 
  is
     pragma autonomous_transaction;
     l_cur_time  date :=sysdate;
     l_limit     number;
     l_last_call date;
  begin
    -- let's know market parametrs
    select nvl(c.call_limit*1/24/60/60,0),c.last_call into l_limit, l_last_call from t_market_connection c where c.id_market = (select m.id from t_market m where m.name=a_mn);
    --
    if l_last_call is not null then 
      while l_cur_time-l_last_call<l_limit loop
        l_cur_time :=sysdate;
      end loop;
    end if;
    -- save to table this
    update t_market_connection c
    set c.last_call = sysdate
    where c.id_market = (select m.id from t_market m where m.name=a_mn);
    commit;
  exception 
    when no_data_found then
      -- there is no such market or limit, well... never mind.
      null;
  end;
  
end pk_tool;
/

prompt
prompt Creating package body PK_VIRCUREX
prompt =================================
prompt
create or replace package body freedom.pk_vircurex is
  
  procedure check_freq 
  is
  begin
    pk_tool.check_freq('vircurex');
  end;
  
  procedure check_status(a_res varchar2)
  is
     j           json;
     l_st        varchar2(20);
  begin
    if INSTR(a_res,'statustxt') <> 0 then
       l_st := 'statustxt';
    else
       l_st := 'statustext';
    end if;
    j:=json(a_res);
    if j.get('status').get_number <> 0 then
        raise_application_error(-20001, j.get(l_st).to_char);
    else
        j.print;
    end if;  
  end;

  function book(a_code_from varchar2, a_code_to varchar2) return pk_tool.TBookStrArr pipelined
  is
       ret      json;
       jbs      json_list;
       j        json_list;
       str      pk_tool.TBookStr;
       --
       l_cnt    number;
  begin
    check_freq;
    -- how much deals per side to return
    select max(p.param_value) into l_cnt from t_system_params p where p.param_code = 'book cnt';
    -- if this is pair ltc - btc
    if a_code_to = 'ltc' and a_code_from = 'btc' then
        ret := json(pk_http.request('https://vircurex.com/api/orderbook.json?base=LTC&alt=BTC'));
       -- buys
       jbs := json_list(ret.get('bids'));
       if jbs.count > 0 then
         for i in 1..least(jbs.count,nvl(l_cnt,jbs.count)) loop
           j := json_list(jbs.get(i));
           str.buysell:='buy';
           str.rate:=j.get(1).get_string;
           str.amount:=j.get(2).get_string;
              pipe row (str);
         end loop;
       end if;
        -- sells
       jbs := json_list(ret.get('asks'));
       if jbs.count > 0 then
         for i in 1..least(jbs.count,nvl(l_cnt,jbs.count)) loop
           j := json_list(jbs.get(i));
           str.buysell:='sell';
           str.rate:=j.get(1).get_string;
           str.amount:=j.get(2).get_string;
              pipe row (str);
         end loop;
       end if;
    end if;
    return;
  end;
  
  function balance return pk_tool.TAmountsArr pipelined
  is
      l_handle  varchar2(200);
      l_id      varchar2(50) :=  pk_lock.lock_and_get_seq('seq_vircurex_api_id',l_handle);
      l_token   varchar2(300);
      l_hash    varchar2(200);
      l_t       varchar2(50) := TO_CHAR(from_tz(localtimestamp, '+03:00') AT TIME ZONE 'UTC','YYYY-MM-DD"T"HH24:MI:SS');
      
      l_res       varchar2(32000);
      --
      l_jres      json;
      l_j         json;
      l_keys      json_list;
      j           json;
      --
      la_bal      pk_tool.TAmounts;
    begin
      check_freq;
      -- token: YourSecurityWord;YourUserName;Timestamp;ID;get_balances
      l_token:= pk_vircurex.g_get_bal_api_key||';alche;'||l_t||';'||l_id||';get_balances';
      -- generating hash
      l_hash := pk_crypto.sha2_hash(l_token);

      l_res:= pk_lock.release_seq(l_handle,   
         pk_http.request(a_adress => 'https://vircurex.com/api/get_balances.json?account=alche'||'&id='||l_id||'&token='||l_hash||'&timestamp='||l_t)
      );
      -- parsing of result
      l_jres := json(l_res);
      
      l_j := json(l_jres.get('balances'));
      l_keys := l_j.get_keys;
      for i in 1..l_keys.count loop
        la_bal.cur := l_keys.get(i).get_string;
        j:= json(l_j.get(la_bal.cur));
        la_bal.amount := to_number(j.get('availablebalance').get_string);
        la_bal.cur := lower(la_bal.cur);
        
        if la_bal.amount > 0 then
           pipe row(la_bal);
        end if;
      end loop;

    end;
    
  function make_order(a_buysell varchar2, a_cur_from varchar2, a_cur_to varchar2, a_rate number, a_amount number) return number
  is
      l_handle  varchar2(200);
      l_id      varchar2(50) := pk_lock.lock_and_get_seq('seq_vircurex_api_id',l_handle);
      l_token   varchar2(300);
      l_hash    varchar2(200);
      l_t       varchar2(50) := TO_CHAR(from_tz(localtimestamp, '+03:00') AT TIME ZONE 'UTC','YYYY-MM-DD"T"HH24:MI:SS');
      
      l_res       varchar2(32000);
      --
      l_jres      json;
      l_j         json;
      l_keys      json_list;
      j           json;
      --
      l_order_id        number;      
    begin
      check_freq;
      -- token: YourSecurityWord;YourUserName;Timestamp;ID;get_balances
      l_token:= pk_vircurex.g_mk_order_api_key||';alche;'||l_t||';'||l_id||';create_order;'||a_buysell||';'||a_amount||';'||a_cur_to||';'||a_rate||';'||a_cur_from;
      -- generating hash
      l_hash := pk_crypto.sha2_hash(l_token);

      l_res:=  
        pk_http.request(a_adress => 'https://vircurex.com/api/create_order.json?account=alche'||'&id='||l_id||'&token='||l_hash||'&timestamp='||l_t||
        '&ordertype='||a_buysell||'&amount='||a_amount||'&currency1='||a_cur_to||'&unitprice='||a_rate||'&currency2='||a_cur_from,a_handle => l_handle);
--      p('1:'||l_res);
--      create_order.json?account=#{user_name}&id=#{trx_id}&token=#{tok}&timestamp=#{t}&ordertype=sell&amount=10&currency1=btc&unitprice=50&currency2=nmc")
      -- parsing of result
      check_status(l_res);

      l_jres := json(l_res);
      l_order_id := l_jres.get('orderid').to_char;

      if l_id is not null then
        begin
            check_freq;
            l_id := pk_lock.lock_and_get_seq('seq_vircurex_api_id',l_handle);
            l_t  := TO_CHAR(from_tz(localtimestamp, '+03:00') AT TIME ZONE 'UTC','YYYY-MM-DD"T"HH24:MI:SS');
            l_token:= pk_vircurex.g_release_api_key||';alche;'||l_t||';'||l_id||';release_order;'||l_order_id;
            -- generating hash
            l_hash := pk_crypto.sha2_hash(l_token);

            l_res:= pk_http.request(a_adress => 'https://vircurex.com/api/release_order.json?account=alche'||'&id='||l_id||'&token='||l_hash||'&timestamp='||l_t||'&orderid='||l_order_id,a_handle => l_handle);

    --        p('2:'||l_res);
            -- parsing
            check_status(l_res);
            l_jres := json(l_res);
            l_order_id := l_jres.get('orderid').to_char;
         exception
           when others then
             p(
                pk_vircurex.cancel_order(l_order_id,0)
             );
             raise;
         end;
      end if;
      
      return l_order_id;
    end;
    
    function cancel_order(a_id number, a_otype number default 1) return varchar2
    is
      l_handle  varchar2(200);
      l_id      varchar2(50) := pk_lock.lock_and_get_seq('seq_vircurex_api_id',l_handle);
      l_token   varchar2(300);
      l_hash    varchar2(200);
      l_t       varchar2(50) := TO_CHAR(from_tz(localtimestamp, '+03:00') AT TIME ZONE 'UTC','YYYY-MM-DD"T"HH24:MI:SS');
      
      l_res       varchar2(32000);
      --
    begin
      check_freq;
      -- token: YourSecurityWord;YourUserName;Timestamp;ID;get_balances
      l_token:= pk_vircurex.g_del_order_api_key||';alche;'||l_t||';'||l_id||';delete_order;'||a_id||';'||a_otype;
      -- generating hash
      l_hash := pk_crypto.sha2_hash(l_token);

      l_res:=  pk_lock.release_seq(l_handle,  
         pk_http.request(a_adress => 'https://vircurex.com/api/delete_order.json?account=alche'||'&id='||l_id||'&token='||l_hash||'&timestamp='||l_t||
        '&orderid='||a_id||'&otype='||a_otype)
      );
--      p('before check:'||l_res);
      check_status(l_res);
      
      return 'ok';
    end;
end pk_vircurex;
/

prompt
prompt Creating type body JSON
prompt =======================
prompt
create or replace type body freedom.json as

  /* Constructors */
  constructor function json return self as result as
  begin
    self.json_data := json_value_array();
    self.check_for_duplicate := 1;
    return;
  end;

  constructor function json(str varchar2) return self as result as
  begin
    self := json_parser.parser(str);
    self.check_for_duplicate := 1;
    return;
  end;

  constructor function json(str in clob) return self as result as
  begin
    self := json_parser.parser(str);
    self.check_for_duplicate := 1;
    return;
  end;

  constructor function json(cast json_value) return self as result as
    x number;
  begin
    x := cast.object_or_array.getobject(self);
    self.check_for_duplicate := 1;
    return;
  end;

  constructor function json(l in out nocopy json_list) return self as result as
  begin
    for i in 1 .. l.list_data.count loop
      if(l.list_data(i).mapname is null or l.list_data(i).mapname like 'row%') then
      l.list_data(i).mapname := 'row'||i;
      end if;
      l.list_data(i).mapindx := i;
    end loop;

    self.json_data := l.list_data;
    self.check_for_duplicate := 1;
    return;
  end;

  /* Member setter methods */
  member procedure remove(self in out nocopy json, pair_name varchar2) as
    temp json_value;
    indx pls_integer;

    function get_member(pair_name varchar2) return json_value as
      indx pls_integer;
    begin
      indx := json_data.first;
      loop
        exit when indx is null;
        if(pair_name is null and json_data(indx).mapname is null) then return json_data(indx); end if;
        if(json_data(indx).mapname = pair_name) then return json_data(indx); end if;
        indx := json_data.next(indx);
      end loop;
      return null;
    end;
  begin
    temp := get_member(pair_name);
    if(temp is null) then return; end if;

    indx := json_data.next(temp.mapindx);
    loop
      exit when indx is null;
      json_data(indx).mapindx := indx - 1;
      json_data(indx-1) := json_data(indx);
      indx := json_data.next(indx);
    end loop;
    json_data.trim(1);
    --num_elements := num_elements - 1;
  end;

  member procedure put(self in out nocopy json, pair_name varchar2, pair_value json_value, position pls_integer default null) as
    insert_value json_value := nvl(pair_value, json_value.makenull);
    indx pls_integer; x number;
    temp json_value;
    function get_member(pair_name varchar2) return json_value as
      indx pls_integer;
    begin
      indx := json_data.first;
      loop
        exit when indx is null;
        if(pair_name is null and json_data(indx).mapname is null) then return json_data(indx); end if;
        if(json_data(indx).mapname = pair_name) then return json_data(indx); end if;
        indx := json_data.next(indx);
      end loop;
      return null;
    end;
  begin
    --dbms_output.put_line('PN '||pair_name);

--    if(pair_name is null) then
--      raise_application_error(-20102, 'JSON put-method type error: name cannot be null');
--    end if;
    insert_value.mapname := pair_name;
--    self.remove(pair_name);
    if(self.check_for_duplicate = 1) then temp := get_member(pair_name); else temp := null; end if;
    if(temp is not null) then
      insert_value.mapindx := temp.mapindx;
      json_data(temp.mapindx) := insert_value;
      return;
    elsif(position is null or position > self.count) then
      --insert at the end of the list
      --dbms_output.put_line('Test');
--      indx := self.count + 1;
      json_data.extend(1);
      json_data(json_data.count) := insert_value;
--      insert_value.mapindx := json_data.count;
      json_data(json_data.count).mapindx := json_data.count;
--      dbms_output.put_line('Test2'||insert_value.mapindx);
--      dbms_output.put_line('Test2'||insert_value.mapname);
--      insert_value.print(false);
--      self.print;
    elsif(position < 2) then
      --insert at the start of the list
      indx := json_data.last;
      json_data.extend;
      loop
        exit when indx is null;
        temp := json_data(indx);
        temp.mapindx := indx+1;
        json_data(temp.mapindx) := temp;
        indx := json_data.prior(indx);
      end loop;
      json_data(1) := insert_value;
      insert_value.mapindx := 1;
    else
      --insert somewhere in the list
      indx := json_data.last;
--      dbms_output.put_line('Test '||indx);
      json_data.extend;
--      dbms_output.put_line('Test '||indx);
      loop
--        dbms_output.put_line('Test '||indx);
        temp := json_data(indx);
        temp.mapindx := indx + 1;
        json_data(temp.mapindx) := temp;
        exit when indx = position;
        indx := json_data.prior(indx);
      end loop;
      json_data(position) := insert_value;
      json_data(position).mapindx := position;
    end if;
--    num_elements := num_elements + 1;
  end;

  member procedure put(self in out nocopy json, pair_name varchar2, pair_value varchar2, position pls_integer default null) as
  begin
    put(pair_name, json_value(pair_value), position);
  end;

  member procedure put(self in out nocopy json, pair_name varchar2, pair_value number, position pls_integer default null) as
  begin
    if(pair_value is null) then
      put(pair_name, json_value(), position);
    else
      put(pair_name, json_value(pair_value), position);
    end if;
  end;

  member procedure put(self in out nocopy json, pair_name varchar2, pair_value boolean, position pls_integer default null) as
  begin
    if(pair_value is null) then
      put(pair_name, json_value(), position);
    else
      put(pair_name, json_value(pair_value), position);
    end if;
  end;

  member procedure check_duplicate(self in out nocopy json, v_set boolean) as
  begin
    if(v_set) then
      check_for_duplicate := 1;
    else
      check_for_duplicate := 0;
    end if;
  end;

  /* deprecated putters */

  member procedure put(self in out nocopy json, pair_name varchar2, pair_value json, position pls_integer default null) as
  begin
    if(pair_value is null) then
      put(pair_name, json_value(), position);
    else
      put(pair_name, pair_value.to_json_value, position);
    end if;
  end;

  member procedure put(self in out nocopy json, pair_name varchar2, pair_value json_list, position pls_integer default null) as
  begin
    if(pair_value is null) then
      put(pair_name, json_value(), position);
    else
      put(pair_name, pair_value.to_json_value, position);
    end if;
  end;

  /* Member getter methods */
  member function count return number as
  begin
    return self.json_data.count;
  end;

  member function get(pair_name varchar2) return json_value as
    indx pls_integer;
  begin
    indx := json_data.first;
    loop
      exit when indx is null;
      if(pair_name is null and json_data(indx).mapname is null) then return json_data(indx); end if;
      if(json_data(indx).mapname = pair_name) then return json_data(indx); end if;
      indx := json_data.next(indx);
    end loop;
    return null;
  end;

  member function get(position pls_integer) return json_value as
  begin
    if(self.count >= position and position > 0) then
      return self.json_data(position);
    end if;
    return null; -- do not throw error, just return null
  end;

  member function index_of(pair_name varchar2) return number as
    indx pls_integer;
  begin
    indx := json_data.first;
    loop
      exit when indx is null;
      if(pair_name is null and json_data(indx).mapname is null) then return indx; end if;
      if(json_data(indx).mapname = pair_name) then return indx; end if;
      indx := json_data.next(indx);
    end loop;
    return -1;
  end;

  member function exist(pair_name varchar2) return boolean as
  begin
    return (self.get(pair_name) is not null);
  end;

  /* Output methods */
  member function to_char(spaces boolean default true, chars_per_line number default 0) return varchar2 as
  begin
    if(spaces is null) then
      return json_printer.pretty_print(self, line_length => chars_per_line);
    else
      return json_printer.pretty_print(self, spaces, line_length => chars_per_line);
    end if;
  end;

  member procedure to_clob(self in json, buf in out nocopy clob, spaces boolean default false, chars_per_line number default 0, erase_clob boolean default true) as
  begin
    if(spaces is null) then
      json_printer.pretty_print(self, false, buf, line_length => chars_per_line, erase_clob => erase_clob);
    else
      json_printer.pretty_print(self, spaces, buf, line_length => chars_per_line, erase_clob => erase_clob);
    end if;
  end;

  member procedure print(self in json, spaces boolean default true, chars_per_line number default 8192, jsonp varchar2 default null) as --32512 is the real maximum in sqldeveloper
    my_clob clob;
  begin
    my_clob := empty_clob();
    dbms_lob.createtemporary(my_clob, true);
    json_printer.pretty_print(self, spaces, my_clob, case when (chars_per_line>32512) then 32512 else chars_per_line end);
    json_printer.dbms_output_clob(my_clob, json_printer.newline_char, jsonp);
    dbms_lob.freetemporary(my_clob);
  end;

  member procedure htp(self in json, spaces boolean default false, chars_per_line number default 0, jsonp varchar2 default null) as
    my_clob clob;
  begin
    my_clob := empty_clob();
    dbms_lob.createtemporary(my_clob, true);
    json_printer.pretty_print(self, spaces, my_clob, chars_per_line);
    json_printer.htp_output_clob(my_clob, jsonp);
    dbms_lob.freetemporary(my_clob);
  end;

  member function to_json_value return json_value as
  begin
    return json_value(sys.anydata.convertobject(self));
  end;

  /* json path */
  member function path(json_path varchar2, base number default 1) return json_value as
  begin
    return json_ext.get_json_value(self, json_path, base);
  end path;

  /* json path_put */
  member procedure path_put(self in out nocopy json, json_path varchar2, elem json_value, base number default 1) as
  begin
    json_ext.put(self, json_path, elem, base);
  end path_put;

  member procedure path_put(self in out nocopy json, json_path varchar2, elem varchar2, base number default 1) as
  begin
    json_ext.put(self, json_path, elem, base);
  end path_put;

  member procedure path_put(self in out nocopy json, json_path varchar2, elem number, base number default 1) as
  begin
    if(elem is null) then
      json_ext.put(self, json_path, json_value(), base);
    else
      json_ext.put(self, json_path, elem, base);
    end if;
  end path_put;

  member procedure path_put(self in out nocopy json, json_path varchar2, elem boolean, base number default 1) as
  begin
    if(elem is null) then
      json_ext.put(self, json_path, json_value(), base);
    else
      json_ext.put(self, json_path, elem, base);
    end if;
  end path_put;

  member procedure path_put(self in out nocopy json, json_path varchar2, elem json_list, base number default 1) as
  begin
    if(elem is null) then
      json_ext.put(self, json_path, json_value(), base);
    else
      json_ext.put(self, json_path, elem, base);
    end if;
  end path_put;

  member procedure path_put(self in out nocopy json, json_path varchar2, elem json, base number default 1) as
  begin
    if(elem is null) then
      json_ext.put(self, json_path, json_value(), base);
    else
      json_ext.put(self, json_path, elem, base);
    end if;
  end path_put;

  member procedure path_remove(self in out nocopy json, json_path varchar2, base number default 1) as
  begin
    json_ext.remove(self, json_path, base);
  end path_remove;

  /* Thanks to Matt Nolan */
  member function get_keys return json_list as
    keys json_list;
    indx pls_integer;
  begin
    keys := json_list();
    indx := json_data.first;
    loop
      exit when indx is null;
      keys.append(json_data(indx).mapname);
      indx := json_data.next(indx);
    end loop;
    return keys;
  end;

  member function get_values return json_list as
    vals json_list := json_list();
  begin
    vals.list_data := self.json_data;
    return vals;
  end;

  member procedure remove_duplicates(self in out nocopy json) as
  begin
    json_parser.remove_duplicates(self);
  end remove_duplicates;


end;
/

prompt
prompt Creating type body JSON_LIST
prompt ============================
prompt
create or replace type body freedom.json_list as

  constructor function json_list return self as result as
  begin
    self.list_data := json_value_array();
    return;
  end;

  constructor function json_list(str varchar2) return self as result as
  begin
    self := json_parser.parse_list(str);
    return;
  end;

  constructor function json_list(str clob) return self as result as
  begin
    self := json_parser.parse_list(str);
    return;
  end;

  constructor function json_list(cast json_value) return self as result as
    x number;
  begin
    x := cast.object_or_array.getobject(self);
    return;
  end;


  member procedure append(self in out nocopy json_list, elem json_value, position pls_integer default null) as
    indx pls_integer;
    insert_value json_value := NVL(elem, json_value);
  begin
    if(position is null or position > self.count) then --end of list
      indx := self.count + 1;
      self.list_data.extend(1);
      self.list_data(indx) := insert_value;
    elsif(position < 1) then --new first
      indx := self.count;
      self.list_data.extend(1);
      for x in reverse 1 .. indx loop
        self.list_data(x+1) := self.list_data(x);
      end loop;
      self.list_data(1) := insert_value;
    else
      indx := self.count;
      self.list_data.extend(1);
      for x in reverse position .. indx loop
        self.list_data(x+1) := self.list_data(x);
      end loop;
      self.list_data(position) := insert_value;
    end if;

  end;

  member procedure append(self in out nocopy json_list, elem varchar2, position pls_integer default null) as
  begin
    append(json_value(elem), position);
  end;

  member procedure append(self in out nocopy json_list, elem number, position pls_integer default null) as
  begin
    if(elem is null) then
      append(json_value(), position);
    else
      append(json_value(elem), position);
    end if;
  end;

  member procedure append(self in out nocopy json_list, elem boolean, position pls_integer default null) as
  begin
    if(elem is null) then
      append(json_value(), position);
    else
      append(json_value(elem), position);
    end if;
  end;

  member procedure append(self in out nocopy json_list, elem json_list, position pls_integer default null) as
  begin
    if(elem is null) then
      append(json_value(), position);
    else
      append(elem.to_json_value, position);
    end if;
  end;

 member procedure replace(self in out nocopy json_list, position pls_integer, elem json_value) as
    insert_value json_value := NVL(elem, json_value);
    indx number;
  begin
    if(position > self.count) then --end of list
      indx := self.count + 1;
      self.list_data.extend(1);
      self.list_data(indx) := insert_value;
    elsif(position < 1) then --maybe an error message here
      null;
    else
      self.list_data(position) := insert_value;
    end if;
  end;

  member procedure replace(self in out nocopy json_list, position pls_integer, elem varchar2) as
  begin
    replace(position, json_value(elem));
  end;

  member procedure replace(self in out nocopy json_list, position pls_integer, elem number) as
  begin
    if(elem is null) then
      replace(position, json_value());
    else
      replace(position, json_value(elem));
    end if;
  end;

  member procedure replace(self in out nocopy json_list, position pls_integer, elem boolean) as
  begin
    if(elem is null) then
      replace(position, json_value());
    else
      replace(position, json_value(elem));
    end if;
  end;

  member procedure replace(self in out nocopy json_list, position pls_integer, elem json_list) as
  begin
    if(elem is null) then
      replace(position, json_value());
    else
      replace(position, elem.to_json_value);
    end if;
  end;

  member function count return number as
  begin
    return self.list_data.count;
  end;

  member procedure remove(self in out nocopy json_list, position pls_integer) as
  begin
    if(position is null or position < 1 or position > self.count) then return; end if;
    for x in (position+1) .. self.count loop
      self.list_data(x-1) := self.list_data(x);
    end loop;
    self.list_data.trim(1);
  end;

  member procedure remove_first(self in out nocopy json_list) as
  begin
    for x in 2 .. self.count loop
      self.list_data(x-1) := self.list_data(x);
    end loop;
    if(self.count > 0) then
      self.list_data.trim(1);
    end if;
  end;

  member procedure remove_last(self in out nocopy json_list) as
  begin
    if(self.count > 0) then
      self.list_data.trim(1);
    end if;
  end;

  member function get(position pls_integer) return json_value as
  begin
    if(self.count >= position and position > 0) then
      return self.list_data(position);
    end if;
    return null; -- do not throw error, just return null
  end;

  member function head return json_value as
  begin
    if(self.count > 0) then
      return self.list_data(self.list_data.first);
    end if;
    return null; -- do not throw error, just return null
  end;

  member function last return json_value as
  begin
    if(self.count > 0) then
      return self.list_data(self.list_data.last);
    end if;
    return null; -- do not throw error, just return null
  end;

  member function tail return json_list as
    t json_list;
  begin
    if(self.count > 0) then
      t := json_list(self.list_data);
      t.remove(1);
      return t;
    else return json_list(); end if;
  end;

  member function to_char(spaces boolean default true, chars_per_line number default 0) return varchar2 as
  begin
    if(spaces is null) then
      return json_printer.pretty_print_list(self, line_length => chars_per_line);
    else
      return json_printer.pretty_print_list(self, spaces, line_length => chars_per_line);
    end if;
  end;

  member procedure to_clob(self in json_list, buf in out nocopy clob, spaces boolean default false, chars_per_line number default 0, erase_clob boolean default true) as
  begin
    if(spaces is null) then
      json_printer.pretty_print_list(self, false, buf, line_length => chars_per_line, erase_clob => erase_clob);
    else
      json_printer.pretty_print_list(self, spaces, buf, line_length => chars_per_line, erase_clob => erase_clob);
    end if;
  end;

  member procedure print(self in json_list, spaces boolean default true, chars_per_line number default 8192, jsonp varchar2 default null) as --32512 is the real maximum in sqldeveloper
    my_clob clob;
  begin
    my_clob := empty_clob();
    dbms_lob.createtemporary(my_clob, true);
    json_printer.pretty_print_list(self, spaces, my_clob, case when (chars_per_line>32512) then 32512 else chars_per_line end);
    json_printer.dbms_output_clob(my_clob, json_printer.newline_char, jsonp);
    dbms_lob.freetemporary(my_clob);
  end;

  member procedure htp(self in json_list, spaces boolean default false, chars_per_line number default 0, jsonp varchar2 default null) as
    my_clob clob;
  begin
    my_clob := empty_clob();
    dbms_lob.createtemporary(my_clob, true);
    json_printer.pretty_print_list(self, spaces, my_clob, chars_per_line);
    json_printer.htp_output_clob(my_clob, jsonp);
    dbms_lob.freetemporary(my_clob);
  end;

  /* json path */
  member function path(json_path varchar2, base number default 1) return json_value as
    cp json_list := self;
  begin
    return json_ext.get_json_value(json(cp), json_path, base);
  end path;


  /* json path_put */
  member procedure path_put(self in out nocopy json_list, json_path varchar2, elem json_value, base number default 1) as
    objlist json;
    jp json_list := json_ext.parsePath(json_path, base);
  begin
    while(jp.head().get_number() > self.count) loop
      self.append(json_value());
    end loop;

    objlist := json(self);
    json_ext.put(objlist, json_path, elem, base);
    self := objlist.get_values;
  end path_put;

  member procedure path_put(self in out nocopy json_list, json_path varchar2, elem varchar2, base number default 1) as
    objlist json;
    jp json_list := json_ext.parsePath(json_path, base);
  begin
    while(jp.head().get_number() > self.count) loop
      self.append(json_value());
    end loop;

    objlist := json(self);
    json_ext.put(objlist, json_path, elem, base);
    self := objlist.get_values;
  end path_put;

  member procedure path_put(self in out nocopy json_list, json_path varchar2, elem number, base number default 1) as
    objlist json;
    jp json_list := json_ext.parsePath(json_path, base);
  begin
    while(jp.head().get_number() > self.count) loop
      self.append(json_value());
    end loop;

    objlist := json(self);

    if(elem is null) then
      json_ext.put(objlist, json_path, json_value, base);
    else
      json_ext.put(objlist, json_path, elem, base);
    end if;
    self := objlist.get_values;
  end path_put;

  member procedure path_put(self in out nocopy json_list, json_path varchar2, elem boolean, base number default 1) as
    objlist json;
    jp json_list := json_ext.parsePath(json_path, base);
  begin
    while(jp.head().get_number() > self.count) loop
      self.append(json_value());
    end loop;

    objlist := json(self);
    if(elem is null) then
      json_ext.put(objlist, json_path, json_value, base);
    else
      json_ext.put(objlist, json_path, elem, base);
    end if;
    self := objlist.get_values;
  end path_put;

  member procedure path_put(self in out nocopy json_list, json_path varchar2, elem json_list, base number default 1) as
    objlist json;
    jp json_list := json_ext.parsePath(json_path, base);
  begin
    while(jp.head().get_number() > self.count) loop
      self.append(json_value());
    end loop;

    objlist := json(self);
    if(elem is null) then
      json_ext.put(objlist, json_path, json_value, base);
    else
      json_ext.put(objlist, json_path, elem, base);
    end if;
    self := objlist.get_values;
  end path_put;

  /* json path_remove */
  member procedure path_remove(self in out nocopy json_list, json_path varchar2, base number default 1) as
    objlist json := json(self);
  begin
    json_ext.remove(objlist, json_path, base);
    self := objlist.get_values;
  end path_remove;


  member function to_json_value return json_value as
  begin
    return json_value(sys.anydata.convertobject(self));
  end;

  /*--backwards compatibility
  member procedure add_elem(self in out nocopy json_list, elem json_value, position pls_integer default null) as begin append(elem,position); end;
  member procedure add_elem(self in out nocopy json_list, elem varchar2, position pls_integer default null) as begin append(elem,position); end;
  member procedure add_elem(self in out nocopy json_list, elem number, position pls_integer default null) as begin append(elem,position); end;
  member procedure add_elem(self in out nocopy json_list, elem boolean, position pls_integer default null) as begin append(elem,position); end;
  member procedure add_elem(self in out nocopy json_list, elem json_list, position pls_integer default null) as begin append(elem,position); end;

  member procedure set_elem(self in out nocopy json_list, position pls_integer, elem json_value) as begin replace(position,elem); end;
  member procedure set_elem(self in out nocopy json_list, position pls_integer, elem varchar2) as begin replace(position,elem); end;
  member procedure set_elem(self in out nocopy json_list, position pls_integer, elem number) as begin replace(position,elem); end;
  member procedure set_elem(self in out nocopy json_list, position pls_integer, elem boolean) as begin replace(position,elem); end;
  member procedure set_elem(self in out nocopy json_list, position pls_integer, elem json_list) as begin replace(position,elem); end;

  member procedure remove_elem(self in out nocopy json_list, position pls_integer) as begin remove(position); end;
  member function get_elem(position pls_integer) return json_value as begin return get(position); end;
  member function get_first return json_value as begin return head(); end;
  member function get_last return json_value as begin return last(); end;
--  */

end;
/

prompt
prompt Creating type body JSON_VALUE
prompt =============================
prompt
create or replace type body freedom.json_value as

  constructor function json_value(object_or_array sys.anydata) return self as result as
  begin
    case object_or_array.gettypename
      when sys_context('userenv', 'current_schema')||'.JSON_LIST' then self.typeval := 2;
      when sys_context('userenv', 'current_schema')||'.JSON' then self.typeval := 1;
      else raise_application_error(-20102, 'JSON_Value init error (JSON or JSON\_List allowed)');
    end case;
    self.object_or_array := object_or_array;
    if(self.object_or_array is null) then self.typeval := 6; end if;

    return;
  end json_value;

  constructor function json_value(str varchar2, esc boolean default true) return self as result as
  begin
    self.typeval := 3;
    if(esc) then self.num := 1; else self.num := 0; end if; --message to pretty printer
    self.str := str;
    return;
  end json_value;

  constructor function json_value(str clob, esc boolean default true) return self as result as
    amount number := 32767;
  begin
    self.typeval := 3;
    if(esc) then self.num := 1; else self.num := 0; end if; --message to pretty printer
    if(dbms_lob.getlength(str) > 32767) then
      extended_str := str;
    end if;
    dbms_lob.read(str, amount, 1, self.str);
    return;
  end json_value;

  constructor function json_value(num number) return self as result as
  begin
    self.typeval := 4;
    self.num := num;
    if(self.num is null) then self.typeval := 6; end if;
    return;
  end json_value;

  constructor function json_value(b boolean) return self as result as
  begin
    self.typeval := 5;
    self.num := 0;
    if(b) then self.num := 1; end if;
    if(b is null) then self.typeval := 6; end if;
    return;
  end json_value;

  constructor function json_value return self as result as
  begin
    self.typeval := 6; /* for JSON null */
    return;
  end json_value;

  static function makenull return json_value as
  begin
    return json_value;
  end makenull;

  member function get_type return varchar2 as
  begin
    case self.typeval
    when 1 then return 'object';
    when 2 then return 'array';
    when 3 then return 'string';
    when 4 then return 'number';
    when 5 then return 'bool';
    when 6 then return 'null';
    end case;

    return 'unknown type';
  end get_type;

  member function get_string(max_byte_size number default null, max_char_size number default null) return varchar2 as
  begin
    if(self.typeval = 3) then
      if(max_byte_size is not null) then
        return substrb(self.str,1,max_byte_size);
      elsif (max_char_size is not null) then
        return substr(self.str,1,max_char_size);
      else
        return self.str;
      end if;
    end if;
    return null;
  end get_string;

  member procedure get_string(self in json_value, buf in out nocopy clob) as
  begin
    if(self.typeval = 3) then
      if(extended_str is not null) then
        dbms_lob.copy(buf, extended_str, dbms_lob.getlength(extended_str));
      else
        dbms_lob.writeappend(buf, length(self.str), self.str);
      end if;
    end if;
  end get_string;


  member function get_number return number as
  begin
    if(self.typeval = 4) then
      return self.num;
    end if;
    return null;
  end get_number;

  member function get_bool return boolean as
  begin
    if(self.typeval = 5) then
      return self.num = 1;
    end if;
    return null;
  end get_bool;

  member function get_null return varchar2 as
  begin
    if(self.typeval = 6) then
      return 'null';
    end if;
    return null;
  end get_null;

  member function is_object return boolean as begin return self.typeval = 1; end;
  member function is_array return boolean as begin return self.typeval = 2; end;
  member function is_string return boolean as begin return self.typeval = 3; end;
  member function is_number return boolean as begin return self.typeval = 4; end;
  member function is_bool return boolean as begin return self.typeval = 5; end;
  member function is_null return boolean as begin return self.typeval = 6; end;

  /* Output methods */
  member function to_char(spaces boolean default true, chars_per_line number default 0) return varchar2 as
  begin
    if(spaces is null) then
      return json_printer.pretty_print_any(self, line_length => chars_per_line);
    else
      return json_printer.pretty_print_any(self, spaces, line_length => chars_per_line);
    end if;
  end;

  member procedure to_clob(self in json_value, buf in out nocopy clob, spaces boolean default false, chars_per_line number default 0, erase_clob boolean default true) as
  begin
    if(spaces is null) then
      json_printer.pretty_print_any(self, false, buf, line_length => chars_per_line, erase_clob => erase_clob);
    else
      json_printer.pretty_print_any(self, spaces, buf, line_length => chars_per_line, erase_clob => erase_clob);
    end if;
  end;

  member procedure print(self in json_value, spaces boolean default true, chars_per_line number default 8192, jsonp varchar2 default null) as --32512 is the real maximum in sqldeveloper
    my_clob clob;
  begin
    my_clob := empty_clob();
    dbms_lob.createtemporary(my_clob, true);
    json_printer.pretty_print_any(self, spaces, my_clob, case when (chars_per_line>32512) then 32512 else chars_per_line end);
    json_printer.dbms_output_clob(my_clob, json_printer.newline_char, jsonp);
    dbms_lob.freetemporary(my_clob);
  end;

  member procedure htp(self in json_value, spaces boolean default false, chars_per_line number default 0, jsonp varchar2 default null) as
    my_clob clob;
  begin
    my_clob := empty_clob();
    dbms_lob.createtemporary(my_clob, true);
    json_printer.pretty_print_any(self, spaces, my_clob, chars_per_line);
    json_printer.htp_output_clob(my_clob, jsonp);
    dbms_lob.freetemporary(my_clob);
  end;

  member function value_of(self in json_value, max_byte_size number default null, max_char_size number default null) return varchar2 as
  begin
    case self.typeval
    when 1 then return 'json object';
    when 2 then return 'json array';
    when 3 then return self.get_string(max_byte_size,max_char_size);
    when 4 then return self.get_number();
    when 5 then if(self.get_bool()) then return 'true'; else return 'false'; end if;
    else return null;
    end case;
  end;

end;
/

prompt
prompt Creating trigger TG_MARKET_CHANGE
prompt =================================
prompt
create or replace trigger freedom.tg_market_change
  before update on t_market  
  for each row
declare
  -- local variables here
begin
  :new.changed:=sysdate;
end tg_market_change;
/

prompt
prompt Creating trigger TG_MARKET_ID
prompt =============================
prompt
create or replace trigger freedom.tg_market_id
  before insert on t_market  
  for each row
declare
  -- local variables here
begin
  select t_market_pk_sq.nextval
  into :new.id
  from dual;  
end tg_market_id;
/

prompt
prompt Creating trigger TG_T_LOG
prompt =========================
prompt
create or replace trigger freedom.tg_t_log
  before insert on t_log  
  for each row
declare
  -- local variables here
begin
  select seq_t_log_id.nextval, sysdate 
  into :new.id, :new.dt
  from dual;
end tg_t_log;
/

prompt
prompt Creating trigger TR_ID_DT
prompt =========================
prompt
create or replace trigger freedom.tr_id_dt
  before insert on t_deals_history
  for each row
declare
  -- local variables here
begin
  select seq_deals_history_pk.nextval, sysdate
  into :new.id, :new.dt
  from dual;
end tr_id_dt;
/


spool off
